inst/shiny-examples/TG-ROC/server.R In UncertainInterval: Uncertain Interval Methods for Three-Way Cut-Point Determination in Test Results

```library(shiny)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

output\$distPlot <- renderPlot({
# generate pdf's based on input\$bins from ui.R
FNR <- input\$FNR
if (input\$combineSliders) updateSliderInput(session, "FPR", value = FNR)
FNR <- input\$FNR
FPR = input\$FPR / 100
FNR = input\$FNR / 100
acc = ifelse(input\$acc==1, .9, .95)

m0=0; sd0=1;
is = qnorm(1-FPR, 0, 1) # x value for 15% FP = intersection
Z = qnorm(FNR) # Z value = 15% FN; Z = (x-mean) / sd
dens = dnorm(is, 0, 1) # density at the point of intersection
sd1 = (1/(dens*sqrt(2*pi)))*exp(-.5 * Z^2)
m1 = is-Z*sd1

x <- seq(-4, 4+m1, length=200)
y0 <- dnorm(x, m0, sd0)
y1 = dnorm(x, m1, sd1)
par(mfrow=c(1,2))
plot(x, y0, type="l", col='black', xlab='Test score', ylab='Density',
main='Probability Density Functions', ylim=c(0,.5))
lines(x, y1, type="l", col='red')
v1 = qnorm(acc)
v2 = qnorm(p=1-acc, mean=m1, sd=sd1)
lines(x=c(v1,v1), y=c(0,.5),col='black', lty=2)
lines(x=c(v2,v2), y=c(0,.5),col='red', lty=2)
lines(x=c(is,is), y=c(0,.5),col='blue', lty=3)
a = (m1-m0)/sd1
b = sd0/sd1
AUC = round(unname(pnorm(a/sqrt(1+b^2))), 4)
legend('topleft', c(paste('Non-Patients = N(', m0,', ', sd0,')', sep=''),
paste('True Patients = N(', round(m1,2),', ', round(sd1,2),')', sep=''),
paste('AUC = ', AUC, sep='')),
text.col= c('black','red', 'black'))

legend('topright', c(paste('Se =', acc),paste('Sp =',acc), 'intersection'), lty=c(2,2,3), col=c('red', 'black', 'blue'))

plot(x, 1-pnorm(x, m1, sd1), type='l', col='red', xlab='Test score',
ylab='Probability', main="TG-ROC curves of Sensitivity and Specificity") # Sensitivity
lines(x, pnorm(x, m0, sd0), type='l', col= 'black') # Specificity
lines(x=c(v1,v1), y=c(0,1),col='black', lty=2)
lines(x=c(v2,v2), y=c(0,1),col='red', lty=2)
abline(h=acc)
if (v1 >= v2){
Se.VR = (1-pnorm(v1, m1, sd1))/(pnorm(v2, m1, sd1)+ 1-pnorm(v1, m1, sd1))
Sp.VR = (pnorm(v2, m0, sd0))/(pnorm(v2, m0, sd0)+ 1-pnorm(v1, m0, sd0))
} else {
Se.VR = (1-pnorm(v2, m1, sd1))/(pnorm(v1, m1, sd1)+ 1-pnorm(v2, m1, sd1))
Sp.VR = (pnorm(v1, m0, sd0))/(pnorm(v1, 0, 1)+ 1-pnorm(v2, m0, sd0))
}
legend('left', paste('Se.VR =', round(Se.VR,2)), text.col='red')
legend('right', paste('Sp.VR =', round(Sp.VR,2)), text.col='black')
par(mfrow=c(1,1))
})
}
```

Try the UncertainInterval package in your browser

Any scripts or data that you put into this service are public.

UncertainInterval documentation built on March 3, 2021, 1:10 a.m.