FRS Project: Demographic Table

By: Abdimajid Mohamed

load("FRSNomogram.RData")

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gtsummary)
library(survival)
library(labelled)
library(tidyverse)
## -- Attaching packages ------------------------------------------------------------------------- tidyverse 1.3.0 --
## v ggplot2 3.3.2     v purrr   0.3.4
## v tibble  3.0.3     v stringr 1.4.0
## v tidyr   1.1.2     v forcats 0.5.0
## v readr   1.3.1
## -- Conflicts ---------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(broom)
library(ggplot2)
library(survminer)
## Loading required package: ggpubr
library(pROC)
## Warning: package 'pROC' was built under R version 4.0.3
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
library(rms)
## Warning: package 'rms' was built under R version 4.0.3
## Loading required package: Hmisc
## Warning: package 'Hmisc' was built under R version 4.0.3
## Loading required package: lattice
## Loading required package: Formula
## Warning: package 'Formula' was built under R version 4.0.3
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## The following objects are masked from 'package:base':
## 
##     format.pval, units
## Loading required package: SparseM
## 
## Attaching package: 'SparseM'
## The following object is masked from 'package:base':
## 
##     backsolve
library(VIM)
## Warning: package 'VIM' was built under R version 4.0.3
## Loading required package: colorspace
## 
## Attaching package: 'colorspace'
## The following object is masked from 'package:pROC':
## 
##     coords
## Loading required package: grid
## VIM is ready to use.
## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
## 
## Attaching package: 'VIM'
## The following object is masked from 'package:datasets':
## 
##     sleep
library(rmarkdown)
library(ROCR)
## Warning: package 'ROCR' was built under R version 4.0.3

Creating Demographic Table: Creating Serious Complication and Any Complication

FRSDemo1 <- 
  mutate(FRSDemo, SeriousComplication = ifelse(CDARREST == "Cardiac Arrest Requiring CPR", "Yes",
                                               ifelse(CDMI == "Myocardial Infarction", "Yes",
                                                      ifelse(OUPNEUMO == "Pneumonia", "Yes",
                                                             ifelse(RENAINSF == "Progressive Renal Insufficiency", "Yes",
                                                                    ifelse(OPRENAFL == "Acute Renal Failure", "Yes",
                                                                           ifelse(PULEMBOL == "Pulmonary Embolism", "Yes",
                                                                                  ifelse(OTHDVT == "DVT Requiring Therapy", "Yes",
                                                                                         ifelse(RETURNOR == "Yes", "Yes",
                                                                                                ifelse(ORGSPCSSI == "Organ/Space SSI", "Yes",
                                                                                                       ifelse(PRSEPIS == "Yes", "Yes",
                                                                                                              ifelse(REINTUB == "Unplanned Intubation", "Yes",
                                                                                                                     ifelse(URNINFEC == "Urinary Tract Infection", "Yes",
                                                                                                                            ifelse(DEHIS == "Wound Disruption", "Yes", "No"))))))))))))))
FRSDemo2 <-
  mutate(FRSDemo1, AnyComplication = ifelse(CDARREST == "Cardiac Arrest Requiring CPR", "Yes",
                                            ifelse(CDMI == "Myocardial Infarction", "Yes",
                                                   ifelse(OUPNEUMO == "Pneumonia", "Yes",
                                                          ifelse(RENAINSF == "Progressive Renal Insufficiency", "Yes",
                                                                 ifelse(OPRENAFL == "Acute Renal Failure", "Yes",
                                                                        ifelse(PULEMBOL == "Pulmonary Embolism", "Yes",
                                                                               ifelse(OTHDVT == "DVT Requiring Therapy", "Yes",
                                                                                      ifelse(RETURNOR == "Yes", "Yes",
                                                                                             ifelse(ORGSPCSSI == "Organ/Space SSI", "Yes",
                                                                                                    ifelse(PRSEPIS == "Yes", "Yes",
                                                                                                           ifelse(REINTUB == "Unplanned Intubation", "Yes",
                                                                                                                  ifelse(URNINFEC == "Urinary Tract Infection", "Yes",
                                                                                                                         ifelse(SUPINFEC == "Superficial Incisional SSI", "Yes",
                                                                                                                                ifelse(FAILWEAN == "On Ventilator greater than 48 Hours", "Yes",
                                                                                                                                       ifelse(CNSCVA == "Stroke/CVA", "Yes",
                                                                                                                                              ifelse(DEHIS == "Wound Disruption", "Yes", "No")))))))))))))))))
FRSDemo2$DOpertoD[is.na(FRSDemo2$DOpertoD)] <- "No"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 0] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 1] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 10] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 11] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 12] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 13] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 14] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 15] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 16] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 18] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 19] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 21] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 22] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 23] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 24] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 25] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 26] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 27] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 28] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 29] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 3] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 30] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 4] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 5] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 6] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 7] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 9] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 17] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 2] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 8] <- "Yes"
FRSDemo2$DOpertoD[FRSDemo2$DOpertoD == 20] <- "Yes"
FRSDemotable <- 
  FRSDemo2 %>%
  select(Fistula.Grade, Age, SEX, BMI, RACE_NEW, PAN_GLANDTEXT, PAN_DUCTSIZE, DIABETES, PAN_MALIG_HISTOLOGIC, ASACLAS, DOpertoD, DPRBILI, PRALBUM, SeriousComplication, AnyComplication, PAN_RADIO, PAN_CHEMO, CPT)
FRSDemoTableFinal <- 
  subset(FRSDemotable, CPT == "48153" | CPT == "48154")
var_label(FRSDemoTableFinal$RACE_NEW) <- "Race"
var_label(FRSDemoTableFinal$ASACLAS) <- "ASA Classification"
var_label(FRSDemoTableFinal$SEX) <- "Sex"
var_label(FRSDemoTableFinal$PAN_GLANDTEXT) <- "Gland Texture"
var_label(FRSDemoTableFinal$PAN_DUCTSIZE) <- "Pancreatic Duct Diameter"
var_label(FRSDemoTableFinal$DOpertoD) <- "Mortality"
var_label(FRSDemoTableFinal$DIABETES) <- "Diabetes"
var_label(FRSDemoTableFinal$SeriousComplication) <- "Serious Complication"
var_label(FRSDemoTableFinal$AnyComplication) <- "Any Complication"
var_label(FRSDemoTableFinal$PAN_CHEMO) <- "Preop Chemotherapy"
var_label(FRSDemoTableFinal$PAN_RADIO) <- "Preop Radiation"
var_label(FRSDemoTableFinal$PAN_MALIG_HISTOLOGIC) <- "Pathology"
var_label(FRSDemoTableFinal$DPRBILI) <- "Preop Bilirubin"
###Recoding Pathology
FRSDemoTableFinal$PAN_MALIG_HISTOLOGIC[FRSDemoTableFinal$PAN_MALIG_HISTOLOGIC =="Other type"] <- NA
FRSDemoTableFinal$PAN_MALIG_HISTOLOGIC[FRSDemoTableFinal$PAN_MALIG_HISTOLOGIC =="N/A"] <- NA
FRSDemoTableFinal$PAN_MALIG_HISTOLOGIC[FRSDemoTableFinal$PAN_MALIG_HISTOLOGIC =="Unknown"] <- NA
FRSDemoTableFinal1 <- 
  FRSDemoTableFinal %>%
  mutate(FRSDemoTableFinal, ChemoOnly = ifelse(PAN_RADIO == "Yes", "No",
                                               ifelse(PAN_CHEMO == "Yes", "Yes", "No")))
FRSDemoTableFinal1[FRSDemoTableFinal1 =="Unknown"] <- NA
FRSDemoTableFinal1 %>%
  tbl_summary(
    by = Fistula.Grade,
    digits = all_continuous() ~ 2,) %>%
  add_p(pvalue_fun = ~style_pvalue(.x, digits = 2))%>%
  bold_p() %>%
  add_overall() %>%
  modify_header(label ~ "**Variable**") %>%
  modify_spanning_header(c("stat_1", "stat_2") ~ "**CR-POPF*") %>%
  bold_labels() 
## There was an error in 'add_p()' for variable 'PAN_MALIG_HISTOLOGIC', p-value omitted:
## Error in stats::fisher.test(data[[variable]], as.factor(data[[by]])): FEXACT error 7(location). LDSTP=17820 is too small for this problem,
##   (pastp=143.358, ipn_0:=ipoin[itp=592]=3520, stp[ipn_0]=178.431).
## Increase workspace or consider using 'simulate.p.value=TRUE'
Variable Overall, N = 5,9751 *CR-POPF p-value2
CR-POPF, N = 1,0181 No CR-POPF, N = 4,9571
Age 66.00 (58.00, 73.00) 66.00 (58.00, 72.00) 66.00 (58.00, 73.00) 0.10
Sex <0.001
female 2,881 (48%) 430 (42%) 2,451 (49%)
male 3,094 (52%) 588 (58%) 2,506 (51%)
BMI 26.52 (23.33, 30.37) 27.97 (24.67, 31.71) 26.21 (23.08, 29.95) <0.001
Race 0.022
Black 499 (9.2%) 63 (6.9%) 436 (9.6%)
Other 303 (5.6%) 46 (5.0%) 257 (5.7%)
White 4,643 (85%) 803 (88%) 3,840 (85%)
Unknown 530 106 424
Gland Texture <0.001
Hard 1,918 (40%) 144 (17%) 1,774 (44%)
Intermediate 580 (12%) 80 (9.6%) 500 (13%)
Soft 2,321 (48%) 608 (73%) 1,713 (43%)
Unknown 1,156 186 970
Pancreatic Duct Diameter <0.001
<3 mm 1,488 (30%) 380 (44%) 1,108 (27%)
>6 mm 752 (15%) 73 (8.5%) 679 (16%)
3-6 mm 2,782 (55%) 405 (47%) 2,377 (57%)
Unknown 953 160 793
Diabetes 1,572 (26%) 215 (21%) 1,357 (27%) <0.001
Pathology
Ampullary carcinoma 478 (11%) 119 (17%) 359 (9.6%)
Cystadenocarcinoma 1 (<0.1%) 0 (0%) 1 (<0.1%)
Distal cholangiocarcinoma 167 (3.8%) 42 (5.9%) 125 (3.4%)
Duodenal carcinoma 126 (2.8%) 24 (3.4%) 102 (2.7%)
IPMN-invasive 121 (2.7%) 21 (3.0%) 100 (2.7%)
Neuroendocrine-functioning 58 (1.3%) 23 (3.2%) 35 (0.9%)
Neuroendocrine-nonfunctioning 306 (6.9%) 89 (13%) 217 (5.8%)
Pancreatic adenocarcinoma 3,181 (72%) 392 (55%) 2,789 (75%)
Unknown 1,537 308 1,229
ASA Classification 0.40
I-II 1,316 (22%) 216 (21%) 1,100 (22%)
III-IV 4,656 (78%) 801 (79%) 3,855 (78%)
None assigned 3 (<0.1%) 1 (<0.1%) 2 (<0.1%)
Mortality 86 (1.4%) 21 (2.1%) 65 (1.3%) 0.091
Preop Bilirubin 8.00 (4.00, 16.00) 8.00 (4.00, 16.00) 8.00 (4.00, 16.00) 0.29
Unknown 226 41 185
PRALBUM 3.90 (3.50, 4.20) 4.00 (3.60, 4.30) 3.90 (3.40, 4.20) <0.001
Unknown 343 75 268
Serious Complication 1,422 (24%) 611 (60%) 811 (16%) <0.001
Any Complication 1,672 (28%) 652 (64%) 1,020 (21%) <0.001
Preop Radiation 343 (5.8%) 32 (3.1%) 311 (6.3%) <0.001
Unknown 24 2 22
Preop Chemotherapy 1,032 (17%) 102 (10%) 930 (19%) <0.001
Unknown 19 1 18
CPT 0.36
48153 5,780 (97%) 990 (97%) 4,790 (97%)
48154 195 (3.3%) 28 (2.8%) 167 (3.4%)
ChemoOnly 715 (12%) 71 (7.0%) 644 (13%) <0.001

1 Statistics presented: Median (IQR); n (%)

2 Statistical tests performed: Wilcoxon rank-sum test; chi-square test of independence; Fisher's exact test

Odds Ratio Code

FRSOddsRatio <- 
  FRSDemoTableFinal %>%
  mutate(FRSDemoTableFinal1, BMIB = ifelse(BMI >= 30, "Obese",
                                           ifelse(BMI <= 30, "Non-Obese", "NA")))
FRSOddsRatio1 <- 
  FRSOddsRatio %>%
  select(Fistula.Grade, Age, SEX, BMIB, RACE_NEW, PAN_GLANDTEXT, PAN_DUCTSIZE, DIABETES, PAN_MALIG_HISTOLOGIC, ASACLAS, DOpertoD, DPRBILI, PRALBUM, SeriousComplication, AnyComplication, PAN_RADIO, PAN_CHEMO, ChemoOnly)
FRSOddsRatio2 <- 
  mutate(FRSOddsRatio1, FistulaOddsRatio = ifelse(Fistula.Grade =="CR-POPF", "1",
                                                  ifelse(Fistula.Grade =="No CR-POPF", "0", "NA")))
FRSOddsRatio3 <-
  mutate(FRSOddsRatio2, Pathology = ifelse(PAN_MALIG_HISTOLOGIC == "Pancreatic adenocarcinoma", "Pancreatic Adenocarcinoma", "Other"))


### Turning NA to the actual NA's that are ommitted in pathology
FRSOddsRatio3$Pathology[FRSOddsRatio3$Pathology =="NA"] <- NA

### recoding ASA none assigned --> NA

FRSOddsRatio3$ASACLAS[FRSOddsRatio3$ASACLAS =="None assigned"] <- NA


###Recoding pancreatic duct diameter
FRSOddsRatio3$PAN_DUCTSIZE[FRSOddsRatio3$PAN_DUCTSIZE ==">6 mm"] <- ">3 mm"
FRSOddsRatio3$PAN_DUCTSIZE[FRSOddsRatio3$PAN_DUCTSIZE =="3-6 mm"] <- ">3 mm"

##Recoding gland texture
FRSOddsRatio3$PAN_GLANDTEXT[FRSOddsRatio3$PAN_GLANDTEXT =="Intermediate"] <- NA


###recode Unknown to NA panductoriginal
FRSOddsRatio3$PAN_DUCTSIZE[FRSOddsRatio3$PAN_DUCTSIZE =="Unknown"] <- NA

FRSOddsRatio3$FistulaOddsRatio <- as.numeric(FRSOddsRatio3$FistulaOddsRatio)

FRSOddsRatio3[FRSOddsRatio3 =="Unknown"] <- NA

table(FRSOddsRatio3$ChemoOnly)
## 
##   No  Yes 
## 5260  715
UV <- FRSOddsRatio3 %>%
  select(Age, SEX, BMIB, RACE_NEW, PAN_GLANDTEXT, PAN_DUCTSIZE, DIABETES, Pathology, ASACLAS, DPRBILI, PRALBUM, FistulaOddsRatio,ChemoOnly) %>%
  tbl_uvregression(
    method = glm,
    y = FistulaOddsRatio,
    method.args = list(family = binomial),
    exponentiate = TRUE,
    pvalue_fun = ~style_pvalue(.x, digits = 2)
  ) %>%
  bold_p(t = 0.10) %>%
  bold_labels() %>%
  italicize_levels()




####Multivariant analysis serious complications
MVOR <- 
  glm(FistulaOddsRatio ~ Age + SEX + BMIB + RACE_NEW + PAN_GLANDTEXT + PAN_DUCTSIZE + DIABETES + Pathology + ASACLAS + DPRBILI + PRALBUM+ ChemoOnly, 
      data = FRSOddsRatio3,
      family = binomial("logit"), 
      na.action =na.omit
  )




###continue on to merge the table sets
MVORTable <-
  tbl_regression(MVOR, exponentiate = T,
                 pvalue_fun = ~style_pvalue(.x, digits = 2),
  ) %>%
  bold_p(t = 0.10) %>%
  bold_labels() %>%
  italicize_levels()


tbl_merge(
  list(UV, MVORTable),
  tab_spanner = c("**Univariable**", "**Multivariable**")
) %>%
  bold_labels() %>%
  italicize_levels()
Characteristic Univariable Multivariable
N OR1 95% CI1 p-value OR1 95% CI1 p-value
Age 5,975 0.99 0.99, 1.00 0.048 1.01 0.99, 1.02 0.33
Sex 5,975
female
male 1.34 1.17, 1.53 <0.001 1.55 1.23, 1.95 <0.001
BMIB 5,975
Non-Obese
Obese 1.71 1.48, 1.97 <0.001 1.77 1.39, 2.26 <0.001
Race 5,445
Black
Other 1.24 0.82, 1.86 0.31 1.14 0.59, 2.16 0.70
White 1.45 1.11, 1.92 0.008 1.44 0.96, 2.25 0.090
Gland Texture 4,239
Hard
Soft 4.37 3.61, 5.32 <0.001 3.30 2.52, 4.35 <0.001
Pancreatic Duct Diameter 5,022
<3 mm
>3 mm 0.46 0.39, 0.53 <0.001 0.63 0.49, 0.79 <0.001
Diabetes 5,975
No
Yes 0.71 0.60, 0.83 <0.001 0.87 0.66, 1.14 0.31
Pathology 4,438
Other
Pancreatic Adenocarcinoma 0.42 0.35, 0.49 <0.001 0.70 0.55, 0.89 0.004
ASA Classification 5,972
I-II
III-IV 1.06 0.90, 1.25 0.50 0.97 0.73, 1.29 0.83
Preop Bilirubin 5,749 1.00 1.00, 1.01 0.76 1.00 0.99, 1.01 0.73
PRALBUM 5,632 1.38 1.22, 1.56 <0.001 1.20 0.98, 1.48 0.079
ChemoOnly 5,975
No
Yes 0.50 0.39, 0.64 <0.001 0.63 0.40, 0.95 0.032

1 OR = Odds Ratio, CI = Confidence Interval

FRSObject2 <- kNN(FRSOddsRatio3)

FRSObject2 <- subset(FRSObject2, select = Fistula.Grade:Pathology)
SeoulFRS <- 
  FRSObject2 %>%
  select(FistulaOddsRatio, ASACLAS, BMIB, PAN_DUCTSIZE, ASACLAS, PRALBUM)

AdjustedFRS <- 
  FRSObject2 %>%
  select(FistulaOddsRatio, PAN_GLANDTEXT, BMIB, PAN_DUCTSIZE)

PortlandFRS <-
  FRSObject2 %>%
  select(FistulaOddsRatio, SEX,PAN_GLANDTEXT, BMIB, PAN_DUCTSIZE, Pathology, ChemoOnly, PRALBUM)

var_label(PortlandFRS$SEX) <- "Sex"
var_label(PortlandFRS$PAN_DUCTSIZE) <- "Duct Size"
var_label(PortlandFRS$PAN_GLANDTEXT) <- "Gland Texture"
var_label(PortlandFRS$BMIB) <- "BMI"
var_label(PortlandFRS$ChemoOnly) <- "Chemotherapy"
var_label(PortlandFRS$PRALBUM) <- "Preop Albumin"
var_label(PortlandFRS$PAN_GLANDTEXT) <- "Gland Texture"

PortlandFRS$SEX[PortlandFRS$SEX =="male"] <- "Male"
PortlandFRS$SEX[PortlandFRS$SEX =="female"] <- "Female"
AdjustedModel <- 
  glm(FistulaOddsRatio~PAN_GLANDTEXT+PAN_DUCTSIZE+BMIB, family = binomial(link = "logit"), data = AdjustedFRS)

AdjPredictModel=predict(AdjustedModel)
AdjPredictModel1=prediction(AdjPredictModel, AdjustedFRS$FistulaOddsRatio)
plot(performance(AdjPredictModel1,"tpr","fpr")) %>%
  abline(a=0,b=1)

##calculate accuracy of above
x=performance(AdjPredictModel1,"acc")
max=which.max(slot(x,"y.values")[[1]])
acc=slot(x,"y.values")[[1]][max]
acc
## [1] 0.8296234
auc=performance(AdjPredictModel1,"auc")
unlist(slot(auc,"y.values"))
## [1] 0.7042941
ci.auc(AdjustedFRS$FistulaOddsRatio, AdjPredictModel)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI: 0.688-0.7205 (DeLong)
SeoulModel <- 
  glm(FistulaOddsRatio~ASACLAS+PAN_DUCTSIZE+BMIB+PAN_DUCTSIZE+PRALBUM, family = binomial(link = "logit"), data = SeoulFRS)

SeoulPredictModel=predict(SeoulModel)
SeoulPredictModel1=prediction(SeoulPredictModel, SeoulFRS$FistulaOddsRatio)
plot(performance(SeoulPredictModel1,"tpr","fpr")) %>%
  abline(a=0,b=1)

x=performance(SeoulPredictModel1,"acc")
max=which.max(slot(x,"y.values")[[1]])
acc=slot(x,"y.values")[[1]][max]
acc
## [1] 0.8297908
auc=performance(SeoulPredictModel1,"auc")
unlist(slot(auc,"y.values"))
## [1] 0.6411078
ci.auc(SeoulFRS$FistulaOddsRatio, SeoulPredictModel)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI: 0.6224-0.6598 (DeLong)
##AUC Model Running for Portland FRS AUC
PortlandModel <- 
  glm(FistulaOddsRatio~SEX+Pathology+ChemoOnly+PAN_GLANDTEXT+PAN_DUCTSIZE+BMIB+PRALBUM, family = binomial(link = "logit"), data = PortlandFRS)

Pr_model=predict(PortlandModel)
Pr_model1=prediction(Pr_model, PortlandFRS$FistulaOddsRatio)
plot(performance(Pr_model1,"tpr","fpr",)) %>%
  abline(a=0,b=1) 

##calculate accuracy of above
x=performance(Pr_model1,"acc")
max=which.max(slot(x,"y.values")[[1]])
acc=slot(x,"y.values")[[1]][max]
acc
## [1] 0.8299582
auc=performance(Pr_model1,"auc")
unlist(slot(auc,"y.values"))
## [1] 0.7235361
ci.auc(PortlandFRS$FistulaOddsRatio, Pr_model)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
## 95% CI: 0.7071-0.74 (DeLong)
###Nomogram build
ddist <- datadist(PortlandFRS)
options(datadist = 'ddist')
mod.bi <- 
  lrm(FistulaOddsRatio~SEX+PAN_GLANDTEXT+BMIB+PAN_DUCTSIZE+ChemoOnly+Pathology, PortlandFRS)

nom.bi <- nomogram(mod.bi,
                   lp.at = seq(-3,4, by=.5),
                   fun = function(x)1/(1+exp(-x)),
                   fun.at = c(.001,.01,.05,seq(.1,.9,by=.1),.95,.99,.999),
                   funlabel = "Risk of Fistula",
                   conf.int = c(0.1,0.7),
                   abbrev = T,
                   minlength = 100,
                   maxscale = 100)

plot(nom.bi,lplabel="Linear Predictor",
     fun.side=c(3,3,1,1,3,1,3,1,1,1,1,1,3),
     conf.space=c(0.1,0.5),
     label.every=1,
     col.grid=gray(c(0.8,0.95)),
     which="shock")