##Statistical Analysis of a Prospective Cohort for Prediction of Difficult Airways##

Loading the packages to be used

library(ROCR)
## Loading required package: gplots
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
## 
##     lowess
library(pROC)
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
library(OptimalCutpoints)
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
library(ggplot2)
library(irr)
## Loading required package: lpSolve
library(car)
## Loading required package: carData

Loading the data table

uaa<-read.csv2("~/Documents/Anestesia/Pesquisa/Ângulos/Table Angle for Publication.csv")
names(uaa)
##  [1] "name"                  "sex"                   "age"                  
##  [4] "weight"                "height"                "asa"                  
##  [7] "intubator.experience"  "snoring"               "beard"                
## [10] "teeth"                 "mouth"                 "smd"                  
## [13] "tmd"                   "ulbt"                  "cervical"             
## [16] "mall"                  "uaa"                   "glottic.height"       
## [19] "jaw.length"            "ketherpal"             "cormack"              
## [22] "intubation.time"       "intubation.tentatives" "alternative.technique"
table(uaa$cormack)
## 
##   1   2   3   4   5 
## 130  49  20  11   1

Cormack labels: 1: Cormack 1 2: Cormack 2A 3: Cormack 2B 4: Cormack 3A 5: Cormack 3B

Undertaking a correlation test by Spearman method between the Upper Airway Angle and the Cormack and Lehane classification

cor.test(uaa$uaa,uaa$cormack,method = "spearman")
## Warning in cor.test.default(uaa$uaa, uaa$cormack, method = "spearman"): Cannot
## compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$uaa and uaa$cormack
## S = 1906079, p-value = 0.001482
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.2174593

Plotting the Upper Airway Angle against the Cormack and Lehane classification

cormack<-factor(uaa$cormack,labels = c("1","2A","2B","3A","3B"))
plot(cormack,uaa$uaa,xlab="Cormack and Lehane Classification",ylab="Upper Airway Angle")

Undertaking a correlation test by Spearman method between the Glottic Height and the Cormack and Lehane classification

cor.test(uaa$glottic.height,uaa$cormack,method = "spearman")
## Warning in cor.test.default(uaa$glottic.height, uaa$cormack, method =
## "spearman"): Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$glottic.height and uaa$cormack
## S = 1320042, p-value = 0.03606
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.1447539

Plotting the Glottic Height against the Cormack and Lehane classification

plot(cormack,uaa$glottic.height,xlab="Cormack and Lehane Classification",ylab="Glottic Height")

Turning the Cormack and Lehane grades into a binary variable: easy vs difficult laryngoscopy

cormackc<-uaa$cormack
cormackc[cormackc<4]=0
cormackc[cormackc>=4]=1
uaa$cormackc<-cormackc
uaa$cormackc<-as.factor(uaa$cormackc)
table(uaa$cormackc)
## 
##   0   1 
## 199  12

Assessing demografic data

#Age
age<-uaa[,c(3,25)]
age<-na.omit(age)
mean(age$age)
## [1] 47.71429
sd(age$age)
## [1] 16.29496
mean(age$age[age$cormackc==0])
## [1] 47.17677
sd(age$age[age$cormackc==0])
## [1] 16.24258
mean(age$age[age$cormackc==1])
## [1] 56.58333
sd(age$age[age$cormackc==1])
## [1] 15.1385
shapiro.test(age$age)
## 
##  Shapiro-Wilk normality test
## 
## data:  age$age
## W = 0.97516, p-value = 0.0009067
wilcox.test(age~cormackc,data=age)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  age by cormackc
## W = 807, p-value = 0.0626
## alternative hypothesis: true location shift is not equal to 0
#Height
height<-uaa[,c(5,25)]
height<-na.omit(height)
mean(height$height)
## [1] 162.1801
sd(height$height)
## [1] 9.955414
mean(height$height[height$cormackc==0])
## [1] 162.0452
sd(height$height[height$cormackc==0])
## [1] 9.81768
mean(height$height[height$cormackc==1])
## [1] 164.4167
sd(height$height[height$cormackc==1])
## [1] 12.30269
shapiro.test(height$height)
## 
##  Shapiro-Wilk normality test
## 
## data:  height$height
## W = 0.98211, p-value = 0.008829
wilcox.test(height~cormackc,data = height)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  height by cormackc
## W = 1103.5, p-value = 0.6605
## alternative hypothesis: true location shift is not equal to 0
#Weight
weight<-uaa[,c(4,25)]
weight<-na.omit(weight)
mean(weight$weight)
## [1] 72.22038
sd(weight$weight)
## [1] 18.38315
mean(weight$weight[weight$cormackc==0])
## [1] 71.77638
sd(weight$weight[weight$cormackc==0])
## [1] 18.40711
mean(weight$weight[weight$cormackc==1])
## [1] 79.58333
sd(weight$weight[weight$cormackc==1])
## [1] 17.03183
shapiro.test(weight$weight)
## 
##  Shapiro-Wilk normality test
## 
## data:  weight$weight
## W = 0.93892, p-value = 9.676e-08
wilcox.test(weight~cormackc,data=weight)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  weight by cormackc
## W = 849.5, p-value = 0.09389
## alternative hypothesis: true location shift is not equal to 0
#Body Mass Index
index<-uaa[,c(4,5,25)]
index$bmi<-index$weight/((index$height/100)**2)
mean(index$bmi)
## [1] 27.43906
sd(index$bmi)
## [1] 6.50702
mean(index$bmi[index$cormackc==0])
## [1] 27.32641
sd(index$bmi[index$cormackc==0])
## [1] 6.585592
mean(index$bmi[index$cormackc==1])
## [1] 29.30709
sd(index$bmi[index$cormackc==1])
## [1] 4.861828
shapiro.test(index$bmi)
## 
##  Shapiro-Wilk normality test
## 
## data:  index$bmi
## W = 0.93063, p-value = 1.908e-08
wilcox.test(bmi~cormackc,data=index)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  bmi by cormackc
## W = 889, p-value = 0.1382
## alternative hypothesis: true location shift is not equal to 0
#Sex
sex<-factor(uaa$sex,labels = c("Man","Woman"))
table(sex)
## sex
##   Man Woman 
##    81   130
prop.table(table(sex))*100
## sex
##      Man    Woman 
## 38.38863 61.61137
table(sex[uaa$cormackc==0])
## 
##   Man Woman 
##    73   126
prop.table((table(sex[uaa$cormackc==0])))*100
## 
##      Man    Woman 
## 36.68342 63.31658
table(sex[uaa$cormackc==1])
## 
##   Man Woman 
##     8     4
prop.table((table(sex[uaa$cormackc==1])))*100
## 
##      Man    Woman 
## 66.66667 33.33333
chisq.test(uaa$sex,uaa$cormackc)
## Warning in chisq.test(uaa$sex, uaa$cormackc): Chi-squared approximation may be
## incorrect
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  uaa$sex and uaa$cormackc
## X-squared = 3.1275, df = 1, p-value = 0.07698
#ASA
table(uaa$asa)
## 
##  1  2  3 
## 82 97 29
prop.table(table(uaa$asa))*100
## 
##        1        2        3 
## 39.42308 46.63462 13.94231
table(uaa$asa[uaa$cormackc==0])
## 
##  1  2  3 
## 80 90 26
prop.table(table(uaa$asa[uaa$cormackc==0]))*100
## 
##        1        2        3 
## 40.81633 45.91837 13.26531
table(uaa$asa[uaa$cormackc==1])
## 
## 1 2 3 
## 2 7 3
prop.table(table(uaa$asa[uaa$cormackc==1]))*100
## 
##        1        2        3 
## 16.66667 58.33333 25.00000
chisq.test(uaa$asa,uaa$cormackc)
## Warning in chisq.test(uaa$asa, uaa$cormackc): Chi-squared approximation may be
## incorrect
## 
##  Pearson's Chi-squared test
## 
## data:  uaa$asa and uaa$cormackc
## X-squared = 3.1634, df = 2, p-value = 0.2056

Assessing association between the Upper Airway Angle and difficult laryngoscopy

shapiro.test(uaa$uaa)
## 
##  Shapiro-Wilk normality test
## 
## data:  uaa$uaa
## W = 0.97225, p-value = 0.000355
wilcox.test(uaa~cormackc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  uaa by cormackc
## W = 2121, p-value = 6.459e-06
## alternative hypothesis: true location shift is not equal to 0

Assessing association between the Glottic Height and difficult laryngoscopy

shapiro.test(uaa$glottic.height)
## 
##  Shapiro-Wilk normality test
## 
## data:  uaa$glottic.height
## W = 0.98988, p-value = 0.1471
t.test(glottic.height~cormackc,data=uaa)
## 
##  Welch Two Sample t-test
## 
## data:  glottic.height by cormackc
## t = -5.0447, df = 12.141, p-value = 0.0002769
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -2.783314 -1.105776
## sample estimates:
## mean in group 0 mean in group 1 
##        2.118788        4.063333
wilcox.test(glottic.height~cormackc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  glottic.height by cormackc
## W = 322.5, p-value = 2.313e-05
## alternative hypothesis: true location shift is not equal to 0

Defining the optimnal cutoff point based on the Youden index of the evaluated tests for difficult laryngoscopy

optimal.uaa<-OptimalCutpoints::optimal.cutpoints(X="uaa", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE, direction= ">")
optimal.gh<-OptimalCutpoints::optimal.cutpoints(X="glottic.height", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction="<")
optimal.ml<-OptimalCutpoints::optimal.cutpoints(X="jaw.length", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction="<")
optimal.cervical<-OptimalCutpoints::optimal.cutpoints(X="cervical", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction="<")
optimal.mall<-OptimalCutpoints::optimal.cutpoints(X="mall", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction="<")
optimal.mouth<-OptimalCutpoints::optimal.cutpoints(X="mouth", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction=">")
optimal.ulbt<-OptimalCutpoints::optimal.cutpoints(X="ulbt", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction="<")
optimal.smd<-OptimalCutpoints::optimal.cutpoints(X="smd", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction=">")
optimal.tmd<-OptimalCutpoints::optimal.cutpoints(X="tmd", status="cormackc", tag.healthy=0,methods="Youden", data=uaa,pop.prev=NULL, control=control.cutpoints(),ci.fit=FALSE,conf.level=0.95,trace=FALSE,direction=">")
optimal.uaa
## 
## Call:
## optimal.cutpoints.default(X = "uaa", status = "cormackc", tag.healthy = 0, 
##     methods = "Youden", data = uaa, direction = ">", pop.prev = NULL, 
##     control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, 
##     trace = FALSE)
## 
## Optimal cutoffs:
##    Youden
## 1 58.0700
## 
## Area under the ROC curve (AUC):  0.888 (0.819, 0.958)
optimal.gh
## 
## Call:
## optimal.cutpoints.default(X = "glottic.height", status = "cormackc", 
##     tag.healthy = 0, methods = "Youden", data = uaa, direction = "<", 
##     pop.prev = NULL, control = control.cutpoints(), ci.fit = FALSE, 
##     conf.level = 0.95, trace = FALSE)
## 
## Optimal cutoffs:
##   Youden
## 1 3.5200
## 
## Area under the ROC curve (AUC):  0.864 (0.727, 1.002)
optimal.ml
## 
## Call:
## optimal.cutpoints.default(X = "jaw.length", status = "cormackc", 
##     tag.healthy = 0, methods = "Youden", data = uaa, direction = "<", 
##     pop.prev = NULL, control = control.cutpoints(), ci.fit = FALSE, 
##     conf.level = 0.95, trace = FALSE)
## 
## Optimal cutoffs:
##   Youden
## 1 9.0000
## 
## Area under the ROC curve (AUC):  0.838 (0.728, 0.947)
optimal.cervical
## 
## Call:
## optimal.cutpoints.default(X = "cervical", status = "cormackc", 
##     tag.healthy = 0, methods = "Youden", data = uaa, direction = "<", 
##     pop.prev = NULL, control = control.cutpoints(), ci.fit = FALSE, 
##     conf.level = 0.95, trace = FALSE)
## 
## Optimal cutoffs:
##    Youden
## 1 39.1000
## 
## Area under the ROC curve (AUC):  0.792 (0.65, 0.934)
optimal.mall
## 
## Call:
## optimal.cutpoints.default(X = "mall", status = "cormackc", tag.healthy = 0, 
##     methods = "Youden", data = uaa, direction = "<", pop.prev = NULL, 
##     control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, 
##     trace = FALSE)
## 
## Optimal cutoffs:
##   Youden
## 1 2.0000
## 
## Area under the ROC curve (AUC):  0.779 (0.684, 0.874)
optimal.mouth
## 
## Call:
## optimal.cutpoints.default(X = "mouth", status = "cormackc", tag.healthy = 0, 
##     methods = "Youden", data = uaa, direction = ">", pop.prev = NULL, 
##     control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, 
##     trace = FALSE)
## 
## Optimal cutoffs:
##   Youden
## 1 4.2000
## 
## Area under the ROC curve (AUC):  0.656 (0.451, 0.86)
optimal.ulbt
## 
## Call:
## optimal.cutpoints.default(X = "ulbt", status = "cormackc", tag.healthy = 0, 
##     methods = "Youden", data = uaa, direction = "<", pop.prev = NULL, 
##     control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, 
##     trace = FALSE)
## 
## Optimal cutoffs:
##   Youden
## 1 1.0000
## 
## Area under the ROC curve (AUC):  0.414 (0.306, 0.522)
optimal.smd
## 
## Call:
## optimal.cutpoints.default(X = "smd", status = "cormackc", tag.healthy = 0, 
##     methods = "Youden", data = uaa, direction = ">", pop.prev = NULL, 
##     control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, 
##     trace = FALSE)
## 
## Optimal cutoffs:
##    Youden
## 1 15.0000
## 
## Area under the ROC curve (AUC):  0.551 (0.348, 0.753)
optimal.tmd
## 
## Call:
## optimal.cutpoints.default(X = "tmd", status = "cormackc", tag.healthy = 0, 
##     methods = "Youden", data = uaa, direction = ">", pop.prev = NULL, 
##     control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, 
##     trace = FALSE)
## 
## Optimal cutoffs:
##   Youden
## 1 8.5000
## 
## Area under the ROC curve (AUC):  0.544 (0.374, 0.714)

Assessing the diagnostic performance of both the Upper Airway Angle and the Glottic Height for difficult laryngoscopy

#For the Upper Airway Angle - We set the cutoff at 60 degrees for the sake of applicability
uaac<-uaa$uaa
uaac[uaac<=60]=1
uaac[uaac>60]=0
uaac<-as.factor(uaac)
table(uaac)
## uaac
##   0   1 
## 124  87
caret::confusionMatrix(uaac,uaa$cormackc,positive="1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 124   0
##          1  75  12
##                                           
##                Accuracy : 0.6445          
##                  95% CI : (0.5759, 0.7091)
##     No Information Rate : 0.9431          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1583          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.00000         
##             Specificity : 0.62312         
##          Pos Pred Value : 0.13793         
##          Neg Pred Value : 1.00000         
##              Prevalence : 0.05687         
##          Detection Rate : 0.05687         
##    Detection Prevalence : 0.41232         
##       Balanced Accuracy : 0.81156         
##                                           
##        'Positive' Class : 1               
## 
#For the Glottic Height - We set the cutoff at 3.5 cm for the sake of applicability
ghc<-uaa$glottic.height
ghc[ghc<3.5]=0
ghc[ghc>=3.5]=1
ghc<-as.factor(ghc)
table(ghc)
## ghc
##   0   1 
## 182  28
caret::confusionMatrix(ghc,uaa$cormackc,positive="1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 180   2
##          1  18  10
##                                           
##                Accuracy : 0.9048          
##                  95% CI : (0.8567, 0.9409)
##     No Information Rate : 0.9429          
##     P-Value [Acc > NIR] : 0.9905483       
##                                           
##                   Kappa : 0.4565          
##                                           
##  Mcnemar's Test P-Value : 0.0007962       
##                                           
##             Sensitivity : 0.83333         
##             Specificity : 0.90909         
##          Pos Pred Value : 0.35714         
##          Neg Pred Value : 0.98901         
##              Prevalence : 0.05714         
##          Detection Rate : 0.04762         
##    Detection Prevalence : 0.13333         
##       Balanced Accuracy : 0.87121         
##                                           
##        'Positive' Class : 1               
##

Plotting density figures to visualize the distribution of the values of both the Upper Airway Angle and the Glottic Height according to difficulty of laryngoscopy defined by the Cormack and Lehahe classification (difficult: grades 3 and 4)

#For the Upper Airway Angle
ggplot(uaa,aes(x=uaa,color=cormackc))+
  geom_density()+
  xlab("Upper Airway Angle")+
  ylab("Density")+
  geom_vline(xintercept=60,linetype="dashed")+
  theme(panel.background = element_blank())+
  theme(axis.line = element_line(linetype = "solid"))+
  labs(color="Laryngoscopy")+
  scale_color_manual(labels=c("Easy","Difficult"),values = c("green","red"))

#For the Glottic Height
ggplot(uaa,aes(x=glottic.height,color=cormackc))+
  geom_density()+
  xlab("Glottic Height")+
  ylab("Density")+
  geom_vline(xintercept = 3.5,linetype="dashed")+
  theme(panel.background = element_blank())+
  theme(axis.line = element_line(linetype = "solid"))+
  labs(color="Laryngoscopy")+
  scale_color_manual(labels=c("Easy","Difficult"),values = c("green","red"))
## Warning: Removed 1 rows containing non-finite values (stat_density).

Assessing the association between the remaining bedside tests and difficult laryngoscopy

#For the Mallampati test
chisq.test(uaa$mall,uaa$cormackc)
## Warning in chisq.test(uaa$mall, uaa$cormackc): Chi-squared approximation may be
## incorrect
## 
##  Pearson's Chi-squared test
## 
## data:  uaa$mall and uaa$cormackc
## X-squared = 11.833, df = 3, p-value = 0.007978
#For mouth opening
shapiro.test(uaa$mouth)
## 
##  Shapiro-Wilk normality test
## 
## data:  uaa$mouth
## W = 0.97278, p-value = 0.0004183
plot(density(uaa$mouth),main="Mouth Opening")

wilcox.test(mouth~cormackc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  mouth by cormackc
## W = 1566, p-value = 0.06837
## alternative hypothesis: true location shift is not equal to 0
#For sternomental distance
shapiro.test(uaa$smd)
## 
##  Shapiro-Wilk normality test
## 
## data:  uaa$smd
## W = 0.97517, p-value = 0.0008788
plot(density(uaa$smd),main="Sternomental Distance")

wilcox.test(smd~cormackc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  smd by cormackc
## W = 1315, p-value = 0.553
## alternative hypothesis: true location shift is not equal to 0
#For thyromental distance
shapiro.test(uaa$tmd)
## 
##  Shapiro-Wilk normality test
## 
## data:  uaa$tmd
## W = 0.90879, p-value = 4.381e-10
plot(density(uaa$tmd),main="Thyromental Distance")

wilcox.test(tmd~cormackc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  tmd by cormackc
## W = 1299.5, p-value = 0.6069
## alternative hypothesis: true location shift is not equal to 0
#For upper lip bite test
chisq.test(uaa$ulbt,uaa$cormackc)
## Warning in chisq.test(uaa$ulbt, uaa$cormackc): Chi-squared approximation may be
## incorrect
## 
##  Pearson's Chi-squared test
## 
## data:  uaa$ulbt and uaa$cormackc
## X-squared = 1.6304, df = 2, p-value = 0.4425
#For neck circunference
cervical<-na.omit(uaa$cervical)
shapiro.test(cervical)
## 
##  Shapiro-Wilk normality test
## 
## data:  cervical
## W = 0.97826, p-value = 0.002546
plot(density(cervical),main="Neck Circunference")

wilcox.test(cervical~cormackc,data = uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  cervical by cormackc
## W = 492.5, p-value = 0.0006977
## alternative hypothesis: true location shift is not equal to 0
#For jaw length
jaw.length<-na.omit(uaa$jaw.length)
shapiro.test(jaw.length)
## 
##  Shapiro-Wilk normality test
## 
## data:  jaw.length
## W = 0.97807, p-value = 0.002315
plot(density(jaw.length),main="Mandibular Length")

wilcox.test(jaw.length~cormackc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  jaw.length by cormackc
## W = 386, p-value = 8.796e-05
## alternative hypothesis: true location shift is not equal to 0

Comparative diagnostic performance amongst the different evaluated predictors

#Buiding up individual models for the comparative diagnostic performance
model.uaa<-glm(cormackc~uaa,data=uaa,family = "binomial")
model.mall<-glm(cormackc~mall,data=uaa,family = "binomial")
model.mouth<-glm(cormackc~mouth,data=uaa,family = "binomial")
model.smd<-glm(cormackc~smd,data=uaa,family = "binomial")
model.tmd<-glm(cormackc~tmd,data=uaa,family = "binomial")
model.ulbt<-glm(cormackc~ulbt,data=uaa,family = "binomial")
model.cervical<-glm(cormackc~cervical,data=uaa,family = "binomial")
model.gh<-glm(cormackc~glottic.height,data=uaa,family = "binomial")
model.jaw<-glm(cormackc~jaw.length,data=uaa,family = "binomial")


#Making the models to undertake predictions
predict.uaa<-predict(model.uaa,newdata = uaa,type = "response")
predict.mall<-predict(model.mall,newdata = uaa,type = "response")
predict.mouth<-predict(model.mouth,newdata = uaa,type = "response")
predict.smd<-predict(model.smd,newdata = uaa,type = "response")
predict.tmd<-predict(model.tmd,newdata = uaa,type = "response")
predict.ulbt<-predict(model.ulbt,newdata = uaa,type = "response")
predict.cervical<-predict(model.cervical,newdata = uaa,type = "response")
predict.gh<-predict(model.gh,newdata = uaa,type = "response")
predict.jaw<-predict(model.jaw,newdata = uaa,type = "response")

#Facing results from the model prediction with actual results from the collected data
prediction.uaa<-ROCR::prediction(predict.uaa,uaa$cormackc)
prediction.mall<-ROCR::prediction(predict.mall,uaa$cormackc)
prediction.mouth<-ROCR::prediction(predict.mouth,uaa$cormackc)
prediction.smd<-ROCR::prediction(predict.smd,uaa$cormackc)
prediction.tmd<-ROCR::prediction(predict.tmd,uaa$cormackc)
prediction.ulbt<-ROCR::prediction(predict.ulbt,uaa$cormackc)
prediction.cervical<-ROCR::prediction(predict.cervical,uaa$cormackc)
prediction.gh<-ROCR::prediction(predict.gh,uaa$cormackc)
prediction.jaw<-ROCR::prediction(predict.jaw,uaa$cormackc)

#Checking the individual performances by the AUC
pROC::roc(uaa$cormackc,uaa$uaa,direction=">")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$uaa, direction = ">")
## 
## Data: uaa$uaa in 199 controls (uaa$cormackc 0) > 12 cases (uaa$cormackc 1).
## Area under the curve: 0.8882
pROC::roc(uaa$cormackc,uaa$mall,direction="<")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$mall, direction = "<")
## 
## Data: uaa$mall in 199 controls (uaa$cormackc 0) < 12 cases (uaa$cormackc 1).
## Area under the curve: 0.7789
pROC::roc(uaa$cormackc,uaa$mouth,direction=">")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$mouth, direction = ">")
## 
## Data: uaa$mouth in 199 controls (uaa$cormackc 0) > 12 cases (uaa$cormackc 1).
## Area under the curve: 0.6558
pROC::roc(uaa$cormackc,uaa$smd,direction=">")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$smd, direction = ">")
## 
## Data: uaa$smd in 199 controls (uaa$cormackc 0) > 12 cases (uaa$cormackc 1).
## Area under the curve: 0.5507
pROC::roc(uaa$cormackc,uaa$tmd,direction=">")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$tmd, direction = ">")
## 
## Data: uaa$tmd in 199 controls (uaa$cormackc 0) > 12 cases (uaa$cormackc 1).
## Area under the curve: 0.5442
pROC::roc(uaa$cormackc,uaa$ulbt,direction=">")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$ulbt, direction = ">")
## 
## Data: uaa$ulbt in 199 controls (uaa$cormackc 0) > 12 cases (uaa$cormackc 1).
## Area under the curve: 0.5858
pROC::roc(uaa$cormackc,uaa$cervical,direction="<")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$cervical,     direction = "<")
## 
## Data: uaa$cervical in 197 controls (uaa$cormackc 0) < 12 cases (uaa$cormackc 1).
## Area under the curve: 0.7917
pROC::roc(uaa$cormackc,uaa$glottic.height,direction="<")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$glottic.height,     direction = "<")
## 
## Data: uaa$glottic.height in 198 controls (uaa$cormackc 0) < 12 cases (uaa$cormackc 1).
## Area under the curve: 0.8643
pROC::roc(uaa$cormackc,uaa$jaw.length,direction="<")
## Setting levels: control = 0, case = 1
## 
## Call:
## roc.default(response = uaa$cormackc, predictor = uaa$jaw.length,     direction = "<")
## 
## Data: uaa$jaw.length in 198 controls (uaa$cormackc 0) < 12 cases (uaa$cormackc 1).
## Area under the curve: 0.8375
#Defining 95% CIs for the AUCs
pROC::ci.auc(uaa$cormackc,uaa$uaa,direction=">")
## Setting levels: control = 0, case = 1
## 95% CI: 0.8186-0.9578 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$mall,direction="<")
## Setting levels: control = 0, case = 1
## 95% CI: 0.6837-0.8741 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$mouth,direction=">")
## Setting levels: control = 0, case = 1
## 95% CI: 0.4513-0.8602 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$smd,direction=">")
## Setting levels: control = 0, case = 1
## 95% CI: 0.3484-0.7529 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$tmd,direction=">")
## Setting levels: control = 0, case = 1
## 95% CI: 0.3739-0.7144 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$ulbt,direction=">")
## Setting levels: control = 0, case = 1
## 95% CI: 0.478-0.6937 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$cervical,direction="<")
## Setting levels: control = 0, case = 1
## 95% CI: 0.6498-0.9336 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$glottic.height,direction="<")
## Setting levels: control = 0, case = 1
## 95% CI: 0.7267-1 (DeLong)
pROC::ci.auc(uaa$cormackc,uaa$jaw.length,direction="<")
## Setting levels: control = 0, case = 1
## 95% CI: 0.7277-0.9474 (DeLong)

Plotting ROC curvers of individual tests for visual comparison

perf.uaa<-ROCR::performance(prediction.uaa,"tpr","fpr")
plot(perf.uaa,xlab="1 - Specificity",ylab="Sensitivity")
perf.mall<-ROCR::performance(prediction.mall,"tpr","fpr")
plot(perf.mall, add=TRUE,col="red")
perf.mouth<-ROCR::performance(prediction.mouth,"tpr","fpr")
plot(perf.mouth,add=TRUE,col="blue")
perf.smd<-ROCR::performance(prediction.smd,"tpr","fpr")
plot(perf.smd,add=TRUE,col="yellow")
perf.tmd<-ROCR::performance(prediction.tmd,"tpr","fpr")
plot(perf.tmd,add=TRUE,col="green")
perf.ulbt<-ROCR::performance(prediction.ulbt,"tpr","fpr")
plot(perf.ulbt,add=TRUE,col="pink")
perf.cervical<-ROCR::performance(prediction.cervical,"tpr","fpr")
plot(perf.cervical,add=TRUE,col="light blue")
perf.gh<-ROCR::performance(prediction.gh,"tpr","fpr")
plot(perf.gh,add=TRUE,col="purple")
perf.jaw<-ROCR::performance(prediction.jaw,"tpr","fpr")
plot(perf.jaw,add=TRUE,col="brown")
lines(c(0,1),c(0,1),col="black")

Assessing the sensitivity and the specificity of each test, as well as their 95% CIs, for the optimal cutoff points

#For the Upper Airway Angle
ss.uaa<-uaa$uaa
ss.uaa[ss.uaa<60]=1
ss.uaa[ss.uaa>=60]=0
table(ss.uaa)
## ss.uaa
##   0   1 
## 125  86
ss.uaa<-as.factor(ss.uaa)
confusionMatrix(ss.uaa,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 125   0
##          1  74  12
##                                           
##                Accuracy : 0.6493          
##                  95% CI : (0.5808, 0.7135)
##     No Information Rate : 0.9431          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1612          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.00000         
##             Specificity : 0.62814         
##          Pos Pred Value : 0.13953         
##          Neg Pred Value : 1.00000         
##              Prevalence : 0.05687         
##          Detection Rate : 0.05687         
##    Detection Prevalence : 0.40758         
##       Balanced Accuracy : 0.81407         
##                                           
##        'Positive' Class : 1               
## 
ss.uaa<-as.numeric(ss.uaa)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.uaa),specificities=0.62814)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp se.low se.median se.high
##  0.62814 0.8506         1       1
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.uaa),sensitivities=1)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##  se sp.low sp.median sp.high
##   1 0.5628    0.6281  0.6935
#For the Glottic Height
ss.gh<-uaa$glottic.height
ss.gh[ss.gh<=3.5]=0
ss.gh[ss.gh>3.5]=1
table(ss.gh)
## ss.gh
##   0   1 
## 183  27
ss.gh<-as.factor(ss.gh)
confusionMatrix(ss.gh,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 181   2
##          1  17  10
##                                           
##                Accuracy : 0.9095          
##                  95% CI : (0.8623, 0.9446)
##     No Information Rate : 0.9429          
##     P-Value [Acc > NIR] : 0.981908        
##                                           
##                   Kappa : 0.471           
##                                           
##  Mcnemar's Test P-Value : 0.001319        
##                                           
##             Sensitivity : 0.83333         
##             Specificity : 0.91414         
##          Pos Pred Value : 0.37037         
##          Neg Pred Value : 0.98907         
##              Prevalence : 0.05714         
##          Detection Rate : 0.04762         
##    Detection Prevalence : 0.12857         
##       Balanced Accuracy : 0.87374         
##                                           
##        'Positive' Class : 1               
## 
ss.gh<-as.numeric(ss.gh)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.gh),specificities=0.91414)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp se.low se.median se.high
##  0.91414 0.4958    0.7792       1
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.gh),sensitivities=0.83333)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       se sp.low sp.median sp.high
##  0.83333 0.3697    0.9082  0.9495
#For Mandibular Length
ss.ml<-uaa$jaw.length
ss.ml[ss.ml<=9]=0
ss.ml[ss.ml>9]=1
table(ss.ml)
## ss.ml
##   0   1 
## 130  80
ss.ml<-as.factor(ss.ml)
confusionMatrix(ss.ml,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 128   2
##          1  70  10
##                                           
##                Accuracy : 0.6571          
##                  95% CI : (0.5887, 0.7211)
##     No Information Rate : 0.9429          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.131           
##                                           
##  Mcnemar's Test P-Value : 2.879e-15       
##                                           
##             Sensitivity : 0.83333         
##             Specificity : 0.64646         
##          Pos Pred Value : 0.12500         
##          Neg Pred Value : 0.98462         
##              Prevalence : 0.05714         
##          Detection Rate : 0.04762         
##    Detection Prevalence : 0.38095         
##       Balanced Accuracy : 0.73990         
##                                           
##        'Positive' Class : 1               
## 
ss.ml<-as.numeric(ss.ml)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.ml),specificities=0.64646)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp se.low se.median se.high
##  0.64646 0.5751    0.8333       1
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.ml),sensitivities=0.83333)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       se sp.low sp.median sp.high
##  0.83333 0.2586    0.6465  0.7383
#For Neck Circunference
ss.cervical<-uaa$cervical
ss.cervical[ss.cervical<=40]=0
ss.cervical[ss.cervical>40]=1
table(ss.cervical)
## ss.cervical
##   0   1 
## 164  45
ss.cervical<-as.factor(ss.cervical)
confusionMatrix(ss.cervical,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 159   5
##          1  38   7
##                                          
##                Accuracy : 0.7943         
##                  95% CI : (0.733, 0.8469)
##     No Information Rate : 0.9426         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.1704         
##                                          
##  Mcnemar's Test P-Value : 1.061e-06      
##                                          
##             Sensitivity : 0.58333        
##             Specificity : 0.80711        
##          Pos Pred Value : 0.15556        
##          Neg Pred Value : 0.96951        
##              Prevalence : 0.05742        
##          Detection Rate : 0.03349        
##    Detection Prevalence : 0.21531        
##       Balanced Accuracy : 0.69522        
##                                          
##        'Positive' Class : 1              
## 
ss.cervical<-as.numeric(ss.cervical)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.cervical),specificities=0.80711)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp se.low se.median se.high
##  0.80711 0.2879    0.5757  0.8374
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.cervical),sensitivities=0.58333)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       se sp.low sp.median sp.high
##  0.58333 0.4791     0.802  0.8837
#For Mallampati
ss.mall<-uaa$mall
ss.mall[ss.mall<=2]=0
ss.mall[ss.mall>2]=1
table(ss.mall)
## ss.mall
##   0   1 
## 150  61
ss.mall<-as.factor(ss.mall)
confusionMatrix(ss.mall,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 146   4
##          1  53   8
##                                           
##                Accuracy : 0.7299          
##                  95% CI : (0.6646, 0.7885)
##     No Information Rate : 0.9431          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1372          
##                                           
##  Mcnemar's Test P-Value : 2.047e-10       
##                                           
##             Sensitivity : 0.66667         
##             Specificity : 0.73367         
##          Pos Pred Value : 0.13115         
##          Neg Pred Value : 0.97333         
##              Prevalence : 0.05687         
##          Detection Rate : 0.03791         
##    Detection Prevalence : 0.28910         
##       Balanced Accuracy : 0.70017         
##                                           
##        'Positive' Class : 1               
## 
ss.mall<-as.numeric(ss.mall)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.mall),specificities=0.73367)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp se.low se.median se.high
##  0.73367 0.3743    0.6543  0.9172
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.mall),sensitivities=0.66667)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       se sp.low sp.median sp.high
##  0.66667 0.3933    0.7286  0.8246
#For Mouth Opening
ss.mouth<-uaa$mouth
ss.mouth[ss.mouth<4]=1
ss.mouth[ss.mouth>=4]=0
table(ss.mouth)
## ss.mouth
##   0   1 
## 197  14
ss.mouth<-as.factor(ss.mouth)
confusionMatrix(ss.mouth,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 188   9
##          1  11   3
##                                           
##                Accuracy : 0.9052          
##                  95% CI : (0.8574, 0.9411)
##     No Information Rate : 0.9431          
##     P-Value [Acc > NIR] : 0.9905          
##                                           
##                   Kappa : 0.1806          
##                                           
##  Mcnemar's Test P-Value : 0.8231          
##                                           
##             Sensitivity : 0.25000         
##             Specificity : 0.94472         
##          Pos Pred Value : 0.21429         
##          Neg Pred Value : 0.95431         
##              Prevalence : 0.05687         
##          Detection Rate : 0.01422         
##    Detection Prevalence : 0.06635         
##       Balanced Accuracy : 0.59736         
##                                           
##        'Positive' Class : 1               
## 
ss.mouth<-as.numeric(ss.mouth)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.mouth),specificities=0.94472)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp  se.low se.median se.high
##  0.94472 0.02084    0.2292  0.5026
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.mouth),sensitivities=0.25000)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##    se sp.low sp.median sp.high
##  0.25 0.7122    0.9397  0.9812
#For Upper Lip Bite Test
ss.ulbt<-uaa$ulbt
ss.ulbt[ss.ulbt<=1]=0
ss.ulbt[ss.ulbt>1]=1
table(ss.ulbt)
## ss.ulbt
##   0   1 
## 144  67
ss.ulbt<-as.factor(ss.ulbt)
confusionMatrix(ss.ulbt,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 134  10
##          1  65   2
##                                           
##                Accuracy : 0.6445          
##                  95% CI : (0.5759, 0.7091)
##     No Information Rate : 0.9431          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : -0.0507         
##                                           
##  Mcnemar's Test P-Value : 4.507e-10       
##                                           
##             Sensitivity : 0.166667        
##             Specificity : 0.673367        
##          Pos Pred Value : 0.029851        
##          Neg Pred Value : 0.930556        
##              Prevalence : 0.056872        
##          Detection Rate : 0.009479        
##    Detection Prevalence : 0.317536        
##       Balanced Accuracy : 0.420017        
##                                           
##        'Positive' Class : 1               
## 
ss.ulbt<-as.numeric(ss.ulbt)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.ulbt),specificities=0.673367)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##        sp se.low se.median se.high
##  0.673367      0    0.1641  0.4042
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.ulbt),sensitivities=0.166667)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##        se sp.low sp.median sp.high
##  0.166667 0.5444    0.6683  0.8714
#For Sternomental Distance
ss.smd<-uaa$smd
ss.smd[ss.smd<15]=1
ss.smd[ss.smd>=15]=0
table(ss.smd)
## ss.smd
##   0   1 
## 169  42
ss.smd<-as.factor(ss.smd)
confusionMatrix(ss.smd,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 161   8
##          1  38   4
##                                           
##                Accuracy : 0.782           
##                  95% CI : (0.7201, 0.8357)
##     No Information Rate : 0.9431          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.0655          
##                                           
##  Mcnemar's Test P-Value : 1.904e-05       
##                                           
##             Sensitivity : 0.33333         
##             Specificity : 0.80905         
##          Pos Pred Value : 0.09524         
##          Neg Pred Value : 0.95266         
##              Prevalence : 0.05687         
##          Detection Rate : 0.01896         
##    Detection Prevalence : 0.19905         
##       Balanced Accuracy : 0.57119         
##                                           
##        'Positive' Class : 1               
## 
ss.smd<-as.numeric(ss.smd)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.smd),specificities=0.80905)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp  se.low se.median se.high
##  0.80905 0.08328    0.3295  0.5934
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.smd),sensitivities=0.33333)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       se sp.low sp.median sp.high
##  0.33333 0.5847     0.804  0.9029
#For Thyromental Distance
ss.tmd<-uaa$tmd
ss.tmd[ss.tmd<8.5]=1
ss.tmd[ss.tmd>=8.5]=0
table(ss.tmd)
## ss.tmd
##   0   1 
## 107 104
ss.tmd<-as.factor(ss.tmd)
confusionMatrix(ss.tmd,uaa$cormackc,positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 103   4
##          1  96   8
##                                          
##                Accuracy : 0.5261         
##                  95% CI : (0.4564, 0.595)
##     No Information Rate : 0.9431         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.04           
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.66667        
##             Specificity : 0.51759        
##          Pos Pred Value : 0.07692        
##          Neg Pred Value : 0.96262        
##              Prevalence : 0.05687        
##          Detection Rate : 0.03791        
##    Detection Prevalence : 0.49289        
##       Balanced Accuracy : 0.59213        
##                                          
##        'Positive' Class : 1              
## 
ss.tmd<-as.numeric(ss.tmd)
pROC::ci.se(pROC::roc(uaa$cormackc,ss.tmd),specificities=0.51759)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       sp se.low se.median se.high
##  0.51759  0.381    0.6699   0.919
pROC::ci.sp(pROC::roc(uaa$cormackc,ss.tmd),sensitivities=0.66667)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI (2000 stratified bootstrap replicates):
##       se sp.low sp.median sp.high
##  0.66667 0.2789    0.5176  0.6638

Estimating odds ratios for each test - regarding their optimal thresholds

#For Upper Airway Angle
fisher.test(ss.uaa,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.uaa and uaa$cormackc
## p-value = 1.293e-05
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  4.492069      Inf
## sample estimates:
## odds ratio 
##        Inf
#For Glottic Height
fisher.test(ss.gh,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.gh and uaa$cormackc
## p-value = 1.282e-08
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##    9.785232 514.412140
## sample estimates:
## odds ratio 
##   51.06153
#For Mandibular Length
fisher.test(ss.ml,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.ml and uaa$cormackc
## p-value = 0.001366
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##   1.854068 87.348575
## sample estimates:
## odds ratio 
##   9.050106
#For Neck Circumference
fisher.test(ss.cervical,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.cervical and uaa$cormackc
## p-value = 0.004674
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##   1.490461 24.483334
## sample estimates:
## odds ratio 
##   5.790251
#For Mallampati
fisher.test(ss.mall,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.mall and uaa$cormackc
## p-value = 0.005946
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##   1.393539 25.796172
## sample estimates:
## odds ratio 
##   5.456689
#For Mouth Opening
fisher.test(ss.mouth,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.mouth and uaa$cormackc
## p-value = 0.03599
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##   0.8580589 27.1818618
## sample estimates:
## odds ratio 
##   5.609754
#For Upper Lip Bite Test
fisher.test(ss.ulbt,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.ulbt and uaa$cormackc
## p-value = 0.3462
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.04288683 2.02400490
## sample estimates:
## odds ratio 
##  0.4137609
#For Sternomental Distance
fisher.test(ss.smd,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.smd and uaa$cormackc
## p-value = 0.2619
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.4415513 8.3812510
## sample estimates:
## odds ratio 
##   2.109434
#For Thyromental Distance
fisher.test(ss.tmd,uaa$cormackc)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  ss.tmd and uaa$cormackc
## p-value = 0.2473
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##   0.5514442 10.0225011
## sample estimates:
## odds ratio 
##   2.138312

Checking for the association between the Upper Airway Angle and difficult facemask ventilation

ketherpal<-uaa$ketherpal
table(ketherpal)
## ketherpal
##   0   1   2   3 
##  25 139  42   4

Obs.: Ketherpal grade zero was assigned to those patients not ventilated

ketherpal[ketherpal==1 | ketherpal==2]=0
ketherpal[ketherpal==3]=1
ketherpal<-as.factor(ketherpal)
uaa$ketherpalc<-ketherpal
wilcox.test(uaa~ketherpalc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  uaa by ketherpalc
## W = 399, p-value = 0.9173
## alternative hypothesis: true location shift is not equal to 0

Checking for the association between the Glottic Height and difficult facemask ventilation

wilcox.test(glottic.height~ketherpalc,data=uaa)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  glottic.height by ketherpalc
## W = 311, p-value = 0.4109
## alternative hypothesis: true location shift is not equal to 0

Checking for the correlation between the Upper Airway Angle and time for intubation

cor.test(uaa$uaa,uaa$intubation.time,method = "spearman")
## Warning in cor.test.default(uaa$uaa, uaa$intubation.time, method = "spearman"):
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$uaa and uaa$intubation.time
## S = 1751579, p-value = 0.08522
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.1187765

Checking for the correlation between the Glottic Height and time for intubation

cor.test(uaa$glottic.height,uaa$intubation.time,method = "spearman")
## Warning in cor.test.default(uaa$glottic.height, uaa$intubation.time, method =
## "spearman"): Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$glottic.height and uaa$intubation.time
## S = 1403126, p-value = 0.1894
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## 0.09092465

Checking for the correlation between the Upper Airway Angle and number of intubation attempts

cor.test(uaa$uaa,uaa$intubation.tentatives,method = "spearman")
## Warning in cor.test.default(uaa$uaa, uaa$intubation.tentatives, method =
## "spearman"): Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$uaa and uaa$intubation.tentatives
## S = 1904938, p-value = 0.001539
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.2167306

Checking for the association between the Glottic Height and number of intubation attempts

cor.test(uaa$glottic.height,uaa$intubation.tentatives,method = "spearman")
## Warning in cor.test.default(uaa$glottic.height, uaa$intubation.tentatives, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$glottic.height and uaa$intubation.tentatives
## S = 1410285, p-value = 0.213
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## 0.08628616

Building up a comparative forest plot with the individual AUCs

forest.uaa<-read.csv2("~/Documents/Anestesia/Pesquisa/Upper Airway Angle/Table for Forest Plot.csv")
forest.uaa$predictor<-factor(forest.uaa$predictor,levels = forest.uaa$predictor[order(forest.uaa$value[forest.uaa$measure=="AUC"])])
              
ggplot(forest.uaa,aes(y=predictor,x=value,xmin=0,xmax=100))+
  geom_point(shape="square",color="blue")+
  geom_errorbarh(aes(xmin=ci.l,xmax=ci.u,height=0.3))+
  labs(y="Predictors")+
  facet_wrap(~measure)+
  geom_vline(xintercept = 50,linetype="dashed")+
  theme(panel.background = element_blank())+
  theme(axis.line.x.bottom = element_blank())+
  theme(axis.line.y.left = element_blank())+
  geom_segment(y=0.5,yend=0.5,x=0,xend=100)+
  theme(axis.text.y.left = element_text(face = "bold",size = 12))+
  theme(axis.title.y.left = element_text(size = 15))+
  theme(axis.title.x.bottom = element_blank())

Sellecting a random sample of 50 patients to check for intra-rater and inter-rater reliability for both UAA and GH

sample(1:211)[1:50]

Estimating intra-rater and inter-rater reliability for both UAA and GH

rely<-read.csv2("~/Documents/Anestesia/Pesquisa/Ângulos/Table for Reliability.csv")

#Intraclass correlation coefficient for UAA - Intra-rater reliability
rely.uaa<-rely[,c(1,3)]
irr::icc(rely.uaa,model = "twoway",type = "agreement",unit = "single")
##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : agreement 
## 
##    Subjects = 50 
##      Raters = 2 
##    ICC(A,1) = 0.883
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##  F(49,49.9) = 16 , p = 3.49e-18 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.803 < ICC < 0.932
#Intraclass correlation coefficient for GH - Intra-rater reliability
rely.gh<-rely[,c(2,4)]
irr::icc(rely.gh,model = "twoway",type = "agreement",unit = "single")
##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : agreement 
## 
##    Subjects = 50 
##      Raters = 2 
##    ICC(A,1) = 0.919
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##  F(49,49.9) = 23.6 , p = 5.17e-22 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.862 < ICC < 0.953
#Intraclass correlation coefficient for UAA - Inter-rater reliability
rely.uaa.2<-rely[,c(3,5)]
irr::icc(rely.uaa.2,model="twoway",type = "agreement",unit = "single")
##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : agreement 
## 
##    Subjects = 50 
##      Raters = 2 
##    ICC(A,1) = 0.955
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##  F(49,48.4) = 44.7 , p = 8.27e-28 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.922 < ICC < 0.974
#Intraclass correlation coefficient for GH - Inter-rater reliability
rely.gh.2<-rely[,c(4,6)]
irr::icc(rely.gh.2,model="twoway",type = "agreement",unit = "single")
##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : agreement 
## 
##    Subjects = 50 
##      Raters = 2 
##    ICC(A,1) = 0.98
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##  F(49,29.3) = 113 , p = 5.53e-24 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.961 < ICC < 0.989

Assessing correlation between number of intubation attempts and both UAA and GH

#For UAA
cor.test(uaa$uaa,uaa$intubation.tentatives,method = "spearman")
## Warning in cor.test.default(uaa$uaa, uaa$intubation.tentatives, method =
## "spearman"): Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$uaa and uaa$intubation.tentatives
## S = 1904938, p-value = 0.001539
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.2167306
#For GH
cor.test(uaa$glottic.height,uaa$intubation.tentatives,method = "spearman")
## Warning in cor.test.default(uaa$glottic.height, uaa$intubation.tentatives, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  uaa$glottic.height and uaa$intubation.tentatives
## S = 1410285, p-value = 0.213
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## 0.08628616
#Plotting the UAA vs number of intubation attempts
plot(uaa$uaa,uaa$intubation.tentatives,xlab="Upper Airway Angle",ylab="Number of Intubation Attempts")