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
|
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")