2020-12-12 17:32:50 +01:00
library ( shiny )
library ( magrittr )
library ( ggplot2 )
library ( plotly )
library ( DT )
2020-12-19 19:25:04 +01:00
calculatorUI <- function ( id ) {
ns <- NS ( id )
fluidPage (
2020-12-12 17:32:50 +01:00
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" )
) ,
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" )
)
)
)
2020-12-19 19:25:04 +01:00
}
2020-12-12 17:32:50 +01:00
2020-12-19 19:25:04 +01:00
calculatorServer <- function ( input , output , session ) {
2020-12-12 17:32:50 +01:00
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 )
}
} )
}