TakeCareApp/app/calculator_view.R

library(shiny)
library(magrittr)
library(ggplot2)
library(plotly)
library(DT)

calculatorViewUI <- function(id){
  ns <- NS(id)
  
  uiOutput("view")
  

}

calculatorViewServer <- function(input, output, session) {
  
  pl <- list(
    emptyTable="Tabela jest pusta",
    sSearch = "Szukaj",
    sInfo="Wyniki od _START_ do _END_ z _TOTAL_ rekordow",
    sZeroRecords="Brak rekordow",
    sEmptyTable="Pusta tabela",
    oPaginate= list(
      sFirst="Pierwsza", sPrevious="Poprzednia",sLast="Ostatnia", sNext="Nastepna"
    ),
    sLengthMenu = "Pokaz _MENU_ rekordow na stronie"
  )
  
  component <- reactive({
    if (is.null(get_query_param()$id)) {
      return(NULL)
    }else{
      return(as.numeric(get_query_param()$id))
    }
        
  })
  
  component2 <- reactive({
    if(length(get_query_param())==1 ){
    queryParam = as.numeric(get_query_param())
    r = httr::GET(paste("https://syi-back.herokuapp.com/api/prediction/get/",as.character(queryParam),sep = ""),add_headers(Authorization=paste("Bearer",input$token,sep=" ")),encode = 'json')
    r

    }
  })
  component3<-eventReactive(input$pageIOTA,{

    if(length(get_query_param())==1 ){
      queryParam = as.numeric(get_query_param())
      r = httr::GET(paste("https://syi-back.herokuapp.com/api/prediction/get/",as.character(queryParam),sep = ""),add_headers(Authorization=paste("Bearer",input$token,sep=" ")),encode = 'json')
      
      r
    }else{
      NULL
    }
  })
  
  observe({
    
    if(get_page()=="iota"){

        shinyjs::runjs('Shiny.onInputChange("pageIOTA", "iota");')



        
        
      }
    
    
    
  })
  
  output$view<-renderUI({
    response <- component3()

    if(is.null(response)){
      
    }else{
      

        r = response

        if(r$status_code==200){
          # print(content(r)$prediction$parameterInts)
          
          
          p=0
          if(as.numeric(content(r)$prediction$parameterInts[[4]]$value)>=50){
            p=50
          }
          
          
          z=-5.3718+0.0354*as.numeric(content(r)$prediction$parameterInts[[1]]$value)+1.6159*as.numeric(content(r)$prediction$parameterInts[[2]]$value)+1.1768*as.numeric(content(r)$prediction$parameterInts[[3]]$value)+0.0697*p+0.9586*as.numeric(content(r)$prediction$parameterInts[[5]]$value)-2.9486*as.numeric(content(r)$prediction$parameterInts[[6]]$value)
          x=seq(by=1,-8,8)
          y=round(1/(1+exp(-x)),3)
          d=data.frame(x,y)


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




          fluidPage(
            fluidRow(
              column(12,
                     tags$div("Kalkulator wskaźnika ryzyka nowotworu jajnika (IOTA LR2)") %>% tagAppendAttributes(class="panel-title"),
                     wellPanel(
                       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."),

                       HTML(paste("Surowa wartość predyktora (im niższa, tym lepiej): ", strong(content(r)$prediction$resultValue))),
                       br(),
                       HTML(content(r)$prediction$resultText),

                       ggplotly(g),
                       disabled(sliderInput("vslider1", strong("Wiek pacjenta:"),min = 14, max = 100, value = content(r)$prediction$parameterInts[[1]]$value)),
                       disabled(radioButtons("vselect1",strong("Obecność wodobrzusza:"),choices = list("Nie"=0,"Tak"=1),selected=content(r)$prediction$parameterInts[[2]]$value)),
                       disabled(radioButtons("vselect2",strong("Obecność przepływu krwi w projekcji brodawkowatej:"),choices = list("Nie"=0,"Tak"=1),selected=content(r)$prediction$parameterInts[[3]]$value)),
                       disabled(sliderInput("vslider2", strong("Największa średnica elementu stałego (w mm):"),min = 0, max = 200, value =content(r)$prediction$parameterInts[[4]]$value)),
                       disabled(radioButtons("vselect3",strong("Nieregularna wewnętrzna ściana torbieli:"),choices = list("Nie"=0,"Tak"=1),selected=content(r)$prediction$parameterInts[[5]]$value)),
                       disabled(radioButtons("vselect4",strong("Obecność cieni akustycznych:"),choices = list("Nie"=0,"Tak"=1),selected=content(r)$prediction$parameterInts[[6]]$value)),
                       downloadButton("reportCalView", "Generuj raport")
                     ))%>% tagAppendAttributes(id = 'column-content')

            ) %>% tagAppendAttributes(id = 'row-content'),
            fluidRow(
              column(12,
                     tags$span("© Copyright Wszystkie prawa zastrzeżone."))%>% tagAppendAttributes(id = 'column-copyright'),
            )%>% tagAppendAttributes(id = 'row-footer')

          )

        }else{
          shinyjs::runjs('window.location.replace(\'/#!/home\');')

        }


      }


    }
    
    )
  
  
  output$reportCalView <- downloadHandler(
    
    filename = "raport.pdf",
    content = function(file) {
      
      tempReport <- file.path(tempdir(), "report.Rmd")
      file.copy("report.Rmd", tempReport, overwrite = TRUE)
      
      p=0
      if(as.numeric(input$vslider2)>=50){
        p=50
      }
      z=-5.3718+0.0354*as.numeric(input$vslider1)+1.6159*as.numeric(input$vselect1)+1.1768*as.numeric(input$vselect2)+0.0697*p+0.9586*as.numeric(input$vselect3)-2.9486*as.numeric(input$vselect4)
      x=round(1/(1+exp(-z)),3)
      params <- list(n = input$vslider1,k=input$vslider2,l=input$vselect1,m=input$vselect2,p=input$vselect3,r=input$vselect4,z=x)
      
      
      rmarkdown::render(tempReport, output_file = file,
                        params = params,
                        envir = new.env(parent = globalenv())
      )
    }
  )


}