100 lines
3.7 KiB
R
100 lines
3.7 KiB
R
|
library(shiny)
|
||
|
|
library(boot)
|
||
|
|
library(ggplot2)
|
||
|
|
library(plotly)
|
||
|
|
library(dplyr)
|
||
|
|
|
||
|
|
ui <- fluidPage(
|
||
|
|
|
||
|
|
titlePanel('Ovarian tumor risk of malignancy index calculator (IOTA LR2)'),
|
||
|
|
|
||
|
|
sidebarPanel(width = 3,
|
||
|
|
div(sliderInput('age',
|
||
|
|
p(strong('Age of the patient (years):')),
|
||
|
|
min = 14, max = 100,
|
||
|
|
value = 40),
|
||
|
|
selectInput('ascites',
|
||
|
|
p(strong('Presence of ascites:')),
|
||
|
|
choices = c('no' = 0, 'yes' = 1),
|
||
|
|
selected = 0),
|
||
|
|
selectInput('blood',
|
||
|
|
p(strong('Presence of blood flow within a papillary projection:')),
|
||
|
|
choices = c('no' = 0, 'yes' = 1),
|
||
|
|
selected = 0),
|
||
|
|
sliderInput('comp',
|
||
|
|
p(strong('Largest diameter of the solid component (in mm):')),
|
||
|
|
min = 0, max = 50,
|
||
|
|
value = 0),
|
||
|
|
selectInput('cyst',
|
||
|
|
p(strong('Irregular internal cyst wall:')),
|
||
|
|
choices = c('no' = 0, 'yes' = 1),
|
||
|
|
selected = 0),
|
||
|
|
selectInput('shadows',
|
||
|
|
p(strong('Presence of acoustic shadows:')),
|
||
|
|
choices = c('no' = 0, 'yes' = 1),
|
||
|
|
selected = 0),
|
||
|
|
|
||
|
|
actionButton('calculate', 'Calculate'))),
|
||
|
|
|
||
|
|
mainPanel(width=8,
|
||
|
|
div(
|
||
|
|
p('This application is designed for gynaecologists and implements ovarian tumor risk malignancy index based on IOTA LR2 algorithm. It also visualises an output of the logistic regression.'),
|
||
|
|
p('For a detailed description of the algorithm please refer to the paper: Timmerman D, Testa AC, Bourne T, [et al.]. Logistic regression model to distinguish between the benign and malignant adnexal mass before surgery: a multicenter study by the International Ovarian Tumor Analysis Group. J Clin Oncol. 2005, 23, 8794-8801.'),
|
||
|
|
h1('Malignancy prediction algorithm'),
|
||
|
|
p('In general, LR2 algorithm predicts a tumor as a benign when a patient is young, a solid component of lesion is small and acoustic shadows are present. You may check it empirically by different combinations of input values.'),
|
||
|
|
p('Fill in the form and click', strong('Calculate'), 'button.'),
|
||
|
|
textOutput('prediction'),
|
||
|
|
textOutput('result'),
|
||
|
|
plotlyOutput('plot')
|
||
|
|
)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
|
||
|
|
server <- function(input, output) {
|
||
|
|
|
||
|
|
f <- function(x) {
|
||
|
|
fx <- 1/(1+exp(-x))
|
||
|
|
}
|
||
|
|
|
||
|
|
iota <- function(age, ascites, blood, comp, cyst, shadows) {
|
||
|
|
z <- -5.3718 + 0.0354*age + 1.6159*ascites + 1.1768*blood + 0.0697*comp + 0.9586*cyst + -2.9486*shadows
|
||
|
|
}
|
||
|
|
|
||
|
|
get_plot <- eventReactive(input$calculate, {
|
||
|
|
|
||
|
|
z <- iota(as.integer(input$age),
|
||
|
|
as.integer(input$ascites),
|
||
|
|
as.integer(input$blood),
|
||
|
|
as.integer(input$comp),
|
||
|
|
as.integer(input$cyst),
|
||
|
|
as.integer(input$shadows))
|
||
|
|
|
||
|
|
fz <- f(z)
|
||
|
|
print(z)
|
||
|
|
|
||
|
|
output$prediction <- renderText(paste('Raw predictor value (the lower, the better):', round(fz, 2)))
|
||
|
|
output$result <- renderText(paste('Class of the tumor:', if (fz>0.1) {'malignant'} else {'benign'}))
|
||
|
|
|
||
|
|
data <- data.frame(x=c(0,1))
|
||
|
|
|
||
|
|
p <- ggplot(data) +
|
||
|
|
annotate('text',
|
||
|
|
x = 5,
|
||
|
|
y = 0.15,
|
||
|
|
label = 'milignancy thershold: 0.1') +
|
||
|
|
stat_function(fun = f, color = 'black') +
|
||
|
|
geom_abline(slope = 0, intercept = 0.1, linetype = 2) +
|
||
|
|
geom_point(aes(z, fz), color = 'red') +
|
||
|
|
labs(y = 'prediction',
|
||
|
|
x= 'premises') +
|
||
|
|
scale_x_continuous(limits = c(-8,8)) +
|
||
|
|
scale_y_continuous(limits = c(0,1)) +
|
||
|
|
theme_classic()
|
||
|
|
|
||
|
|
ggplotly(p)
|
||
|
|
|
||
|
|
})
|
||
|
|
output$plot <- renderPlotly(get_plot())
|
||
|
|
}
|
||
|
|
|
||
|
|
shinyApp(ui=ui, server=server)
|