125 lines
5.3 KiB
R
125 lines
5.3 KiB
R
library(shiny)
|
|
library(magrittr)
|
|
library(ggplot2)
|
|
library(plotly)
|
|
library(DT)
|
|
|
|
calculatorUI <- function(id){
|
|
ns <- NS(id)
|
|
fluidPage(
|
|
titlePanel("Kalkulator wskaźnika ryzyka nowotworu jajnika (IOTA LR2)"),
|
|
sidebarLayout(
|
|
sidebarPanel(
|
|
sliderInput("slider1", strong("Wiek pacjenta:"),min = 14, max = 100, value = 40),
|
|
selectInput("select1",strong("Obecność wodobrzusza:"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
|
selectInput("select2",strong("Obecność przepływu krwi w projekcji brodawkowatej:"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
|
sliderInput("slider2", strong("Największa średnica elementu stałego (w mm):"),min = 0, max = 200, value = 0),
|
|
selectInput("select3",strong("Nieregularna wewnętrzna ściana torbieli:"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
|
selectInput("select4",strong("Obecność cieni akustycznych:"),choices = list("Nie"=0,"Tak"=1),selected=0),
|
|
actionButton("update" ,"Oblicz"),
|
|
downloadButton("report", "Generuj raport")
|
|
),
|
|
|
|
mainPanel(
|
|
p("Aplikacja przeznaczona jest dla lekarzy ginekologów i wdraża wskaźnik złośliwości nowotworu jajnika w oparciu o algorytm IOTA LR2. Wizualizuje również wynik regresji logistycznej."),
|
|
p("Szczegółowy opis algorytmu znajduje się w artykule: Timmerman D, Testa AC, Bourne T, [i in.]. Model regresji logistycznej do rozróżniania łagodnych i złośliwych guzów przydatków przed operacją: wieloośrodkowe badanie przeprowadzone przez International Ovarian Tumor Analysis Group. J Clin Oncol. 2005, 23, 8794-8801."),
|
|
p("Ogólnie algorytm LR2 przewiduje, że nowotwór jest łagodny, gdy pacjent jest młody, lity składnik zmiany jest mały i występują cienie akustyczne. Możesz to sprawdzić empirycznie za pomocą różnych kombinacji wartości wejściowych."),
|
|
p("Wypełnij formularz i kliknij",strong("Oblicz")," "),
|
|
|
|
htmlOutput("selected_var"),
|
|
htmlOutput("var"),
|
|
br(),
|
|
plotlyOutput("wykres")
|
|
)
|
|
)
|
|
)
|
|
}
|
|
|
|
calculatorServer <- function(input, output, session) {
|
|
|
|
|
|
output$report <- downloadHandler(
|
|
# For PDF output, change this to "report.pdf"
|
|
filename = "raport.pdf",
|
|
content = function(file) {
|
|
# Copy the report file to a temporary directory before processing it, in
|
|
# case we don't have write permissions to the current working dir (which
|
|
# can happen when deployed).
|
|
tempReport <- file.path(tempdir(), "report.Rmd")
|
|
file.copy("report.Rmd", tempReport, overwrite = TRUE)
|
|
|
|
# Set up parameters to pass to Rmd document
|
|
p=0
|
|
if(as.numeric(input$slider2)>=50){
|
|
p=50
|
|
}
|
|
z=-5.3718+0.0354*as.numeric(input$slider1)+1.6159*as.numeric(input$select1)+1.1768*as.numeric(input$select2)+0.0697*p+0.9586*as.numeric(input$select3)-2.9486*as.numeric(input$select4)
|
|
x=round(1/(1+exp(-z)),3)
|
|
params <- list(n = input$slider1,k=input$slider2,l=input$select1,m=input$select2,p=input$select3,r=input$select4,z=x,y=)
|
|
|
|
# Knit the document, passing in the `params` list, and eval it in a
|
|
# child of the global environment (this isolates the code in the document
|
|
# from the code in this app).
|
|
rmarkdown::render(tempReport, output_file = file,
|
|
params = params,
|
|
envir = new.env(parent = globalenv())
|
|
)
|
|
}
|
|
)
|
|
|
|
output$selected_var <- renderText({
|
|
input$update
|
|
p=0
|
|
if(as.numeric(isolate(input$slider2))>=50){
|
|
p=50
|
|
}
|
|
z=-5.3718+0.0354*as.numeric(isolate(input$slider1))+1.6159*as.numeric(isolate(input$select1))+1.1768*as.numeric(isolate(input$select2))+0.0697*p+0.9586*as.numeric(isolate(input$select3))-2.9486*as.numeric(isolate(input$select4))
|
|
x=round(1/(1+exp(-z)),3)
|
|
if(as.numeric(input$update)>0){
|
|
paste("Surowa wartość predyktora (im niższa, tym lepiej): ", strong(x))
|
|
}
|
|
})
|
|
|
|
output$var <- renderText({
|
|
input$update
|
|
p=0
|
|
if(as.numeric(isolate(input$slider2))>=50){
|
|
p=50
|
|
}
|
|
z=-5.3718+0.0354*as.numeric(isolate(input$slider1))+1.6159*as.numeric(isolate(input$select1))+1.1768*as.numeric(isolate(input$select2))+0.0697*p+0.9586*as.numeric(isolate(input$select3))-2.9486*as.numeric(isolate(input$select4))
|
|
x=round(1/(1+exp(-z)),3)
|
|
if(as.numeric(input$update)>0){
|
|
if(x>0.1){
|
|
paste("Klasa guza: ",strong("złośliwy"))
|
|
} else {
|
|
paste("Klasa guza: ",strong("łagodny"))
|
|
}
|
|
}
|
|
})
|
|
|
|
output$wykres <- renderPlotly({
|
|
input$update
|
|
p=0
|
|
if(as.numeric(isolate(input$slider2))>=50){
|
|
p=50
|
|
}
|
|
z=-5.3718+0.0354*as.numeric(isolate(input$slider1))+1.6159*as.numeric(isolate(input$select1))+1.1768*as.numeric(isolate(input$select2))+0.0697*p+0.9586*as.numeric(isolate(input$select3))-2.9486*as.numeric(isolate(input$select4))
|
|
x=seq(by=1,-8,8)
|
|
y=round(1/(1+exp(-x)),3)
|
|
d=data.frame(x,y)
|
|
if(as.numeric(input$update)>0){
|
|
g=ggplot(data=d,aes(x=x,y=y))+
|
|
geom_line()+
|
|
geom_point(aes(x=z,y=round(1/(1+exp(-z)),3)),color="red",size=4)+
|
|
geom_hline(aes(yintercept=0.1),linetype = "dashed")+
|
|
geom_text(aes(x=6,y=0.15),label="próg złośliwości: 0.1")+
|
|
labs(x="Realność",y="Prognoza")+
|
|
theme_light()
|
|
ggplotly(g)
|
|
}
|
|
|
|
|
|
})
|
|
}
|
|
|