server = (function(input, output, session) {
filePath = path_user_base
shinyjs::hide("cal")
credentials <- callModule(Rshinytemplate::login, "login",
filePath = filePath,
user_col = user,
pwd_col = password,
hashed = TRUE,
algo = "md5",
log_out = reactive(logout_init()))
logout_init <- callModule(Rshinytemplate::logout, "logout", reactive(credentials()$user_auth))
observe({
if(credentials()$user_auth) {
shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
} else {
shinyjs::addClass(selector = "body", class = "sidebar-collapse")
}
})
user_info <- reactive({ credentials()$info})
output$welcome <- renderText({
req(credentials()$user_auth)
glue("Welcome back {user_info()$name}!")
})
#switch entre page d'authentification et le shiny Irma
observe({
if (credentials()$user_auth == TRUE) {
output$page <- renderUI({
print(paste0("Connexion de ", user_info()$name))
ui2()})
updateTabItems(session, "tabs", "patient")
updateTabItems(session, "tabs", "Admin")
updateTabItems(session, "tabs", "patient")
} else {
output$page <- renderUI({
})
}
})
### UI admin ###
output$admin = renderUI({
req(user_info()$permissions)
user_auth <- user_info()$permissions
user_name <- user_info()$name
user <- user_info()$user
if (user_auth == "administrator") {
fluidPage(
fluidRow(
column(width = 4,
box(title = "New user creation", status = "danger", solidHeader = TRUE, width = NULL, height = 450,
#uiOutput("list_user"),
textInput("user", "New user ID", ""),
textInput("name", "First name / Last name new user", ""),
selectInput("permissions", "New user permissions", c("administrator", "standard")),
passwordInput("password", "Initial password", ""),
actionButton("create_user", "Create"),
h5(" "),
htmlOutput("show_confirmation_creation")
)
),
column(width = 4,
box(width = NULL,
title = "Users list", status = "danger", solidHeader = TRUE, height = 450,
dataTableOutput("user_plot")
)
),
column(width = 4,
box(title = "User deletion", status = "danger", solidHeader = TRUE, width = NULL, height = 450,
uiOutput("list_user"),
actionButton("erase_user", "Delete"),
#HTML(paste(textOutput("show_confirmation"), tags$span(style="color:white"))),
htmltools::span(textOutput("show_confirmation"), style="color:white"),
conditionalPanel(
condition = "output.show_confirmation == '1'",
h5("Do you really want to delete this user?"),
actionButton("erase_user_confirmation_yes", "Yes"),
actionButton("erase_user_confirmation_no", "No")
)
))
),
fluidRow(
box(
title = "User password change", status = "primary", solidHeader = TRUE,
passwordInput("old_password", "Old password", ""),
passwordInput("new_password1", "New password", ""),
passwordInput("new_password2", "New password", ""),
actionButton("change_password", "Change"),
h5(" "),
htmlOutput("change_password_message")
)
),
fluidRow(
),
)
} else {
# if permissions == standard
fluidRow(
box(
title = "User password change", status = "warning", solidHeader = TRUE,
passwordInput("old_password", "Old password", ""),
passwordInput("new_password1", "New password", ""),
passwordInput("new_password2", "New password", ""),
actionButton("change_password", "Change"),
h5(" "),
htmlOutput("change_password_message")
)
)
}
})
user_maj <- function() {
user_base <- readRDS(path_user_base)
user_base <- user_base[, .(user, name, permissions)]
return(user_base)
}
#initialisation
output$user_plot <- renderDataTable(user_maj(), options = list(searching = FALSE, paging = FALSE))
output$list_user <- renderUI({
user_base <- user_maj()
users <- user_base[name != user_info()$name]$name
selectInput('name_to_erase', NULL, users, multiple = FALSE)
})
output$show_confirmation <- renderText('0')
observeEvent(input$erase_user, {
output$show_confirmation <- renderText('1')
})
observeEvent(input$erase_user_confirmation_no, {
output$show_confirmation <- renderText('0')
})
observeEvent(input$erase_user_confirmation_yes, {
user_to_erase <- user_maj()[name == input$name_to_erase]$user
if (!is.null(user_to_erase) | user_to_erase != "") {
user2erase <- user_to_erase
user_erase <- function(path_user_base, user_to_erase)
{
# browser()
# user <- NULL
user_base <- base::readRDS(path_user_base)
if (user_to_erase %in% user_base$user) {
user_base <- user_base[user != user_to_erase]
saveRDS(user_base, path_user_base)
}
}
user_erase(path_user_base = filePath, user_to_erase = user2erase)
output$user_plot <- renderDataTable(user_maj(), options = list(searching = FALSE, paging = FALSE))
output$list_user <- renderUI({
user_base <- user_maj()
users <- user_base[name != user_info()$name]$name
selectInput('name_to_erase', NULL, users, multiple = FALSE)
})
output$show_confirmation <- renderText('0')
}
})
observeEvent(input$create_user, {
message_password <- check_password(input$password)
if (message_password == 0) {
message <- user_new(path_user_base = filePath, user = input$user, password = input$password, permissions = input$permissions, name = input$name)
#maj
output$user_plot <- renderDataTable(user_maj(), options = list(searching = FALSE, paging = FALSE))
output$list_user <- renderUI({
user_base <- user_maj()
users <- user_base[name != user_info()$name]$name
selectInput('name_to_erase', NULL, users, multiple = FALSE) })
} else {
message <- message_password
}
output$show_confirmation_creation <- renderText({ message })
})
observeEvent(input$change_password, {
message_password <- check_password(input$new_password1)
if (message_password == 0) {
message <- user_modify_password(path_user_base = filePath, user_to_modify = user_info()$user, old_password = input$old_password, new_password1 = input$new_password1, new_password2 = input$new_password2)
} else {
message <- message_password
}
output$change_password_message <- renderText({ message })
})
#### ICI début du shiny ######
#Reactives
input_file_rv <- reactiveValues(data_path = NULL, nb_coupe =0, clear = TRUE)
#on lit régulierement le fichier base patient pour voir s'il y a des modifs
base_patient <- reactiveFileReader(1000,
session,
file.path(path_data, "base_patient.rds"),
readRDS)
#render UI
observe({
output$select_patient = renderUI({
base_patient <- base_patient()
list_input <- base_patient$id
names(list_input) <- paste0(base_patient$first_name, " " ,base_patient$last_name)
selectizeInput("select_patient", NULL,
choices = list_input, selected = "0", multiple = FALSE)
})
})
observeEvent(input$click_patient , {
shinyjs::hide("cut_visu")
base_patient <- base_patient()
input_file_rv$data_path <- NULL
selected_patient <- base_patient[input$select_patient == id]
liste_choix <- c("Non", "Difficultés mais a réussi", "A eu besoin d'une aide", "Dépendant d'une tierce personne", "Ne sait pas")
if (input$select_patient == "0") {
#on veut ajouter un nouveau patient
shinyjs::show("fiche_patient")
shinyjs::hide("mri_load")
shinyjs::hide("patient_selected")
shinyjs::hide("patient_selected_rem")
shinyjs::hide("patient_selected_rem2")
shinyjs::hide("patient_selected_rem3")
shinyjs::hide("cut_selection")
shinyjs::hide("cut_visu")
shinyjs::hide("prev_irm")
shinyjs::hide("ihm_prev")
shinyjs::hide("ihm_prev_irm")
shinyjs::hide("ihm_prev_patient")
shinyjs::hide("prev_coupe")
shinyjs::hide("prev_coupe")
output$info_patient = renderUI({
useSweetAlert()
box(
width = 12,
status = "primary", solidHeader = TRUE,
title = "Nouvelle fiche patient",
fluidRow(
column(width = 1, h1(), h1(), tags$b(paste0("ID #", nrow(base_patient)))),
column(width = 1, h1(), h1(), prettyToggle( inputId = "genre", label_on = "Homme", label_off = "Femme" )),
column(width = 3, offset = 0, label = "", textInput(inputId = "last_name", label = "", value = "Nom")),
column(width = 3, textInput(inputId = "first_name", label = "", value = "Prénom")),
column(width = 4, dateInput("date_admin", label = "", value = Sys.Date()))),
fluidRow(
column(width = 4, sliderInput("age_at_diagnosis", label = "Age :", min = 0, max = 120, value = 70, step = 1)),
column(width = 4, sliderInput("size", label = "Taille [m] :", min = 0.5, max = 2.5, value = 1.75, step = 0.01)),
column(width = 4, sliderInput("weight", label = "Poids [kg] :", min = 0, max = 200, value = 70, step = 1))
),
fluidRow(
column(width = 10,
tags$b("Entêtement : "), tags$i("Le patient s'entête-t-il et refuse-t-il l'aide des autres ?")),
column(width = 2, prettySwitch(inputId = "agit", label = "Non/Oui", status = "success", fill = TRUE))
),
fluidRow(
column(width = 10,
tags$b("Dépression : "), tags$i("Le patient connait-il des épisodes de dépression ou de dysphorie ?")),
column(width = 2, prettySwitch(inputId = "depress", label = "Non/Oui", status = "success", fill = TRUE))
),
fluidRow(
column(width = 10,
tags$b("Anxiété : "), tags$i("Le patient est-il anxieux ?")),
column(width = 2, prettySwitch(inputId = "anxiety", label = "Non/Oui", status = "success", fill = TRUE))
),
fluidRow(
column(width = 10,
tags$b("Apathie : "), tags$i("Le patient est-il apathique ?")),
column(width = 2, prettySwitch(inputId = "apathy", label = "Non/Oui", status = "success", fill = TRUE))
),
fluidRow(
column(width = 10,
tags$b("Désinhibé : "), tags$i("Le patient est-il désinhibé ?")),
column(width = 2, prettySwitch(inputId = "disinhib", label = "Non/Oui", status = "success", fill = TRUE))
),
fluidRow(
column(width = 10,
tags$b("Irritable : "), tags$i("Le patient est-il irritable ?")),
column(width = 2, prettySwitch(inputId = "irr", label = "Non/Oui", status = "success", fill = TRUE))
),
fluidRow(
column(width = 12,
tags$b("Argent : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés ou besoin d'aide pour écrire un chèque, payer avec des billets... ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "bills", label = NULL, choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Factures : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés pour gérer ses papiers, payer ses factures, etc... ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "taxes", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Shopping : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés pour faire ses courses ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "shopping", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Jeu : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il rencontré des difficultés pour jouer à un jeu de réflexion (bridge, échecs..) ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "games", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Repas : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés lors de la préparation d'un repas équilibré ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "meal", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Evénements : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se rappeler d'événements courants ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "event", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Concentration : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se concentrer et à comprendre un programme TV, un livre ou un magazine ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "concentration", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Souvenir dates : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se souvenir de dates ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "remdates", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Déplacements : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se déplacer en dehors de son quartier, à conduire, ou à prendre les transports en commun ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "travel", label = NULL,choiceValues = c(0, 1, 2, 3, 8),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Autonomie : "), tags$i("Quel est le niveau d'indépendance du patient ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "independ", label = NULL,choiceValues = c(1, 2, 3, 4, 9),
choiceNames = c("En capacité de vivre seul", "Requiert une assistance pour des activités particulièrement complexes", "Requiert une assistace pour des activités quotidiennes", "Dépendant", "Ne sait pas"),
inline = FALSE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12, h4(),
div(style="display: inline-block; vertical-align:top; width: 150px;", actionButton("click_add_patient", "Ajouter"))))
)
})
} else {
if (selected_patient$genre == "Homme") {
genre_toggle <- TRUE }
else {
genre_toggle <- FALSE}
#on veut simplement visualiser la fiche patient ou la modifier
output$info_patient = renderUI({
box(
width = 12,
status = "primary", solidHeader = TRUE,
title = "Fiche patient",
fluidRow(
column(width = 1, h1(), h1(), tags$b(paste0("ID #", selected_patient$id ))),
column(width = 1, h1(), h1(), prettyToggle( inputId = "genre_modif", label_on = "Homme", label_off = "Femme" , value = genre_toggle)),
column(width = 3, offset = 0, label = "", textInput(inputId = "last_name_modif", label = "", value = selected_patient$last_name)),
column(width = 3, textInput(inputId = "first_name_modif", label = "", value = selected_patient$first_name)),
column(width = 4, dateInput("date_admin_modif", label = "", value = as.Date(selected_patient$date_entry)))),
fluidRow(
column(width = 4, sliderInput("age_at_diagnosis_modif", label = "Age :", min = 0, max = 120, value = selected_patient$age_at_diagnosis, step = 1)),
column(width = 4, sliderInput("size_modif", label = "Taille [m] :", min = 0.5, max = 2.5, value = selected_patient$size, step = 0.01)),
column(width = 4, sliderInput("weight_modif", label = "Poids [kg] :", min = 0, max = 200, value = selected_patient$weight, step = 1))
),
fluidRow(
column(width = 10,
tags$b("Entêtement : "), tags$i("Le patient s'entête-t-il et refuse-t-il l'aide des autres ?")),
column(width = 2, prettySwitch(inputId = "agit_modif", label = "Non/Oui", status = "success", fill = TRUE, value = selected_patient$agit))
),
fluidRow(
column(width = 10,
tags$b("Dépression : "), tags$i("Le patient connait-il des épisodes de dépression ou de dysphorie ?")),
column(width = 2, prettySwitch(inputId = "depress_modif", label = "Non/Oui", status = "success", fill = TRUE, value = selected_patient$depress))
),
fluidRow(
column(width = 10,
tags$b("Anxiété : "), tags$i("Le patient est-il anxieux ?")),
column(width = 2, prettySwitch(inputId = "anxiety_modif", label = "Non/Oui", status = "success", fill = TRUE, value = selected_patient$anxiety))
),
fluidRow(
column(width = 10,
tags$b("Apathie : "), tags$i("Le patient est-il apathique ?")),
column(width = 2, prettySwitch(inputId = "apathy_modif", label = "Non/Oui", status = "success", fill = TRUE, value = selected_patient$apathy))
),
fluidRow(
column(width = 10,
tags$b("Désinhibé : "), tags$i("Le patient est-il désinhibé ?")),
column(width = 2, prettySwitch(inputId = "disinhib_modif", label = "Non/Oui", status = "success", fill = TRUE, value = selected_patient$disinhib))
),
fluidRow(
column(width = 10,
tags$b("Irritable : "), tags$i("Le patient est-il irritable ?")),
column(width = 2, prettySwitch(inputId = "irr_modif", label = "Non/Oui", status = "success", fill = TRUE, value = selected_patient$irr))
),
fluidRow(
column(width = 12,
tags$b("Argent : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés ou besoin d'aide pour écrire un chèque, payer avec des billets... ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "bills_modif", label = NULL, choiceValues = c(0, 1, 2, 3, 8), selected = as.numeric(selected_patient$bills),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Factures : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés pour gérer ses papiers, payer ses factures, etc... ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "taxes_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8), selected = as.numeric(selected_patient$taxes),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Shopping : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés pour faire ses courses ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "shopping_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8),selected = as.numeric(selected_patient$shopping),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Jeu : "), tags$i("Dans les 4 dernières semaines, le patient a-t-il rencontré des difficultés pour jouer à un jeu de réflexion (bridge, échecs..) ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "games_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8), selected = as.numeric(selected_patient$games),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Repas : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés lors de la préparation d'un repas équilibré ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "meal_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8),selected = as.numeric(selected_patient$meal),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Evénements : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se rappeler d'événements courants ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "event_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8),selected = as.numeric(selected_patient$event),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Concentration : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se concentrer et à comprendre un programme TV, un livre ou un magazine ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "concentration_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8),selected = as.numeric(selected_patient$concentration),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Souvenir dates : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se souvenir de dates ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "remdates_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8),selected = as.numeric(selected_patient$remdates),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Déplacements : "), tags$i("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se déplacer en dehors de son quartier, à conduire, ou à prendre les transports en commun ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "travel_modif", label = NULL,choiceValues = c(0, 1, 2, 3, 8),selected = as.numeric(selected_patient$travel),
choiceNames = liste_choix,
inline = TRUE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12,
tags$b("Autonomie : "), tags$i("Quel est le niveau d'indépendance du patient ?"))),
fluidRow(
column(width = 12, h5(),
prettyRadioButtons( inputId = "independ_modif", label = NULL,choiceValues = c(1, 2, 3, 4, 9),selected = as.numeric(selected_patient$independ),
choiceNames = c("En capacité de vivre seul", "Requiert une assistance pour des activités particulièrement complexes", "Requiert une assistace pour des activités quotidiennes", "Dépendant", "Ne sait pas"),
inline = FALSE, status = "danger", fill = TRUE
))
),
fluidRow(
column(width = 12, h4(),
div(style="display: inline-block; vertical-align:top; width: 150px;", actionButton("click_modify_patient", "Modifier", width = "160px")), " ",
div(style="display: inline-block; vertical-align:top; width: 150px; margin-left:30px", actionButton("click_erase_patient", "Supprimer", width = "160px"))))
)
})
shinyjs::show("mri_load")
shinyjs::show("fiche_patient")
shinyjs::show("patient_selected")
shinyjs::show("patient_selected_rem")
shinyjs::show("patient_selected_rem2")
shinyjs::show("patient_selected_rem3")
shinyjs::show("ihm_prev")
shinyjs::show("ihm_prev_irm")
shinyjs::show("ihm_prev_patient")
shinyjs::hide("prev_coupe")
output$prev_patient = renderUI({
NULL
})
output$prev = renderUI({
NULL
})
path_mri_id <- paste0("mri_id_", base_patient[input$select_patient == id]$id)
if (dir.exists(file.path(path_data, path_mri_id ))) {
list_png <- list.files(file.path(path_data, path_mri_id ), pattern = ".png", recursive = FALSE)
nb_cut <- length(list_png)
shinyjs::show("cut_selection")
} else {
nb_cut <- 0
shinyjs::hide("cut_selection")
shinyjs::hide("cut_visu")
shinyjs::hide("prev_coupe")
}
input_file_rv$nb_coupe <- nb_cut
reset('input_img')
input_file_rv$clear <- TRUE
input_file_rv$data_path <- NULL
output$contents <- renderUI({NULL})
}
output$patient_select = renderUI({
base_patient <- base_patient()
selected_patient <- base_patient[input$select_patient == id]
input$select_var
select_var = c("Age", "Taille", "Poids", "Entêtement", "Dépression", "Anxiété", "Apathie", "Désinhibé",
"Irritable", "Argent", "Factures", "Shopping", "Jeu", "Repas",
"Evénements", "Concentration", "Souvenir dates", "Déplacements", "Autonomie")
dt_var = c("age_at_diagnosis","size", "weight","agit","depress","anxiety","apathy","disinhib",
"irr","bills","taxes","shopping","games","meal","event","concentration","remdates","travel", "independ")
dt_corresp <- data.table(select_var = select_var, dt_var=dt_var)
var <- dt_corresp[select_var == input$select_var]$dt_var
if (var %in% c("bills", "taxes", "shopping", "games", "meal", "event", "concentration", "remdates","travel", "independ"))
{
dt_corresp_value <- data.table(value = c(0, 1, 2, 3, 8),
value_label = c("Non","Il a rencontré des difficulté, mais a réussi seul",
"Il a eu besoin d'une aide","Il a été dépendant d'une tierce personne","Ne sait pas"))
}
if (var %in% c("independ"))
{
dt_corresp_value <- data.table(value = c(1, 2, 3, 4, 9),
value_label = c("En capacité de vivre seul", "Requiert une assistance pour des activités particulièrement complexes", "Requiert une assistace pour des activités quotidiennes", "Dépendant", "Ne sait pas")
)
}
if (var %in% c("agit", "depress", "anxiety", "apathy", "disinhib", "irr"))
{
dt_corresp_value <- data.table(value = c(TRUE, FALSE),
value_label = c("Oui","Non"))
}
if (!var %in% c("age_at_diagnosis", "size", "weight")) {
var_to_display <- dt_corresp_value[value == selected_patient[, .(get(var))]$V1]$value_label
} else {
var_to_display <- selected_patient[, .(get(var))]$V1
}
box(
width = 12,
status = "primary", solidHeader = TRUE,
title = "Patient sélectionné",
#tags$head(tags$style(HTML(".small-box {height: 100px}"))),
fluidRow (tags$head(tags$style(HTML('.info-box {min-height: 90px;} .info-box-content {padding-top: 15px; padding-bottom: 15px;}'))),
infoBox(title = paste0(selected_patient$first_name, " ", selected_patient$last_name),
paste0(selected_patient$genre , " - ", selected_patient$age_at_diagnosis, " ans - ", selected_patient$size , " m"),icon = icon("users", lib = "font-awesome"),
color = "light-blue", fill =TRUE, width = 6
),
tags$head(tags$style(HTML(".small-box {height: 90px}"))),
valueBox(tags$p(paste0(as.character(var_to_display)), style = "font-size: 50%;"), paste0("Variable ", input$select_var, " du patient sélectionné"), icon = icon("question", lib = "font-awesome"), color = "olive", width = 6)
))
})
output$patient_select_reminder = renderUI({
base_patient <- base_patient()
selected_patient <- base_patient[input$select_patient == id]
path_mri_id <- paste0("mri_id_", selected_patient$id)
if (dir.exists(file.path(path_data, path_mri_id ))) {
list_png <- list.files(file.path(path_data, path_mri_id ), pattern = ".png", recursive = FALSE)
nb_cut <- length(list_png)
} else {
nb_cut <- 0
}
box(
width = 12,
status = "primary", solidHeader = TRUE,
title = "Patient sélectionné",
fluidRow(tags$head(tags$style(HTML('.info-box {min-height: 90px;} .info-box-content {padding-top: 15px; padding-bottom: 15px;}'))),
infoBox(title = paste0(selected_patient$first_name, " ", selected_patient$last_name),
paste0(selected_patient$genre , " - ", selected_patient$age_at_diagnosis, " ans - ", selected_patient$size , " m"),icon = icon("users", lib = "font-awesome"),
color = "light-blue", fill =TRUE, width = 8
),
tags$head(tags$style(HTML(".small-box {height: 90px}"))),
valueBox(tags$p(paste0(as.character(input_file_rv$nb_coupe), " coupes"), style = "font-size: 80%;"), "Nombre de coupes en base pour ce patient", icon = icon("brain", lib = "font-awesome"), color = "olive", width = 4)
))
})
output$patient_select_reminder2 = renderUI({
base_patient <- base_patient()
selected_patient <- base_patient[input$select_patient == id]
box(
width = 12,
status = "primary", solidHeader = TRUE,
title = "Patient sélectionné",
fluidRow(tags$head(tags$style(HTML('.info-box {min-height: 90px;} .info-box-content {padding-top: 15px; padding-bottom: 15px;}'))),
infoBox(title = paste0(selected_patient$first_name, " ", selected_patient$last_name),
paste0(selected_patient$genre , " - ", selected_patient$age_at_diagnosis, " ans - ", selected_patient$size , " m"),icon = icon("users", lib = "font-awesome"),
color = "light-blue", fill =TRUE, width = 12
)))
})
output$patient_select_reminder3 = renderUI({
base_patient <- base_patient()
selected_patient <- base_patient[input$select_patient == id]
box(
width = 12,
status = "primary", solidHeader = TRUE,
title = "Patient sélectionné",
fluidRow(tags$head(tags$style(HTML('.info-box {min-height: 90px;} .info-box-content {padding-top: 15px; padding-bottom: 15px;}'))),
infoBox(title = paste0(selected_patient$first_name, " ", selected_patient$last_name),
paste0(selected_patient$genre , " - ", selected_patient$age_at_diagnosis, " ans - ", selected_patient$size , " m"),icon = icon("users", lib = "font-awesome"),
color = "light-blue", fill =TRUE, width = 12
)))
})
})
#ajouter une fiche à la base
observeEvent(input$click_add_patient , {
base_patient <- base_patient()
if (input$genre == FALSE) {
genre <- "Femme"
} else {
genre <- "Homme"
}
new_patient <- data.table(id = nrow(base_patient),
first_name = input$first_name,
last_name = input$last_name,
age_at_diagnosis = input$age_at_diagnosis,
date_entry = as.character(input$date_admin),
genre = genre,
size = input$size,
weight = input$weight,
agit = input$agit,
depress = input$depress,
anxiety = input$anxiety,
apathy = input$apathy,
disinhib = input$disinhib,
irr = input$irr,
bills = input$bills,
taxes = input$taxes,
shopping =input$shopping,
games = input$games,
meal =input$meal,
event = input$event,
concentration = input$concentration,
remdates = input$remdates,
travel = input$travel,
independ = input$independ)
base_patient <- rbind(base_patient, new_patient)
saveRDS(base_patient, file = file.path(path_data, "base_patient.rds"))
sendSweetAlert(
session = session,
title = "Succès !",
text = "Une nouvelle fiche a été ajoutée à la base",
type = "success"
)
shinyjs::hide("fiche_patient")
shinyjs::hide("patient_selected")
shinyjs::hide("patient_selected_rem")
shinyjs::hide("patient_selected_rem2")
shinyjs::hide("patient_selected_rem3")
})
#modifier une fiche existante
observeEvent(input$click_modify_patient , {
base_patient <- base_patient()
selected_patient <- base_patient[input$select_patient == id]
if (input$genre_modif == FALSE) {
genre <- "Femme"
} else {
genre <- "Homme"
}
modif_patient <- data.table(id = selected_patient$id,
first_name = input$first_name_modif,
last_name = input$last_name_modif,
age_at_diagnosis = input$age_at_diagnosis_modif,
date_entry = as.character(input$date_admin_modif),
genre = genre,
size = input$size_modif,
weight = input$weight_modif,
agit = input$agit_modif,
depress = input$depress_modif,
anxiety = input$anxiety_modif,
apathy = input$apathy_modif,
disinhib = input$disinhib_modif,
irr = input$irr_modif,
bills = input$bills_modif,
taxes = input$taxes_modif,
shopping =input$shopping_modif,
games = input$games_modif,
meal =input$meal_modif,
event = input$event_modif,
concentration = input$concentration_modif,
remdates = input$remdates_modif,
travel = input$travel_modif,
independ = input$independ_modif)
base_patient <- rbind(base_patient[id != selected_patient$id], modif_patient)
saveRDS(base_patient, file = file.path(path_data, "base_patient.rds"))
shinyjs::hide("fiche_patient")
shinyjs::hide("patient_selected")
shinyjs::hide("patient_selected_rem")
shinyjs::hide("patient_selected_rem2")
shinyjs::hide("patient_selected_rem3")
sendSweetAlert(
session = session,
title = "Succès !",
text = "La fiche a été modifiée",
type = "success"
)
})
observeEvent(input$click_erase_patient , {
base_patient <- base_patient()
id_selected_patient <- base_patient[input$select_patient == id]$id
path_mri_id <- paste0("mri_id_", id_selected_patient)
unlink(file.path(path_data, path_mri_id), recursive = TRUE)
base_patient <- base_patient[input$select_patient != id]
saveRDS(base_patient, file = file.path(path_data, "base_patient.rds"))
shinyjs::hide("fiche_patient")
sendSweetAlert(
session = session,
title = "Succès !",
text = "La fiche a été supprimée de la base",
type = "success"
)
})
observeEvent(input$input_img$datapath, {
print("Event!")
print(input$input_img$datapath)
if(input_file_rv$clear) {
#browser()
#inFile <- input$input_img
input_file_rv$data_path <- input$input_img$datapath
if (is.null(input_file_rv$data_path )) {
output$contents <- renderUI({NULL})
} else {
#menage dans le dir de destination
base_patient <- base_patient()
id_selected_patient <- base_patient[input$select_patient == id]$id
path_mri_id <- paste0("mri_id_", id_selected_patient)
if (!dir.exists(file.path(path_data, path_mri_id )))
{
dir.create(file.path(path_data, path_mri_id ))
} else {
file.remove(list.files(file.path(path_data, path_mri_id ), pattern = ".png", full.names = TRUE))
}
#on convert le nii en png
withProgress(message = 'Conversion en png...',{
setProgress(value = 0.3 , message = "Conversion en png...")
workdir <- getwd()
setwd(file.path(path_root, "inst/python/"))
cmd_convertion <- paste0("python3 nii2png.py -i ", input_file_rv$data_path, " -o ", file.path(path_data, path_mri_id))
system(cmd_convertion)
setwd(workdir)
nb_png <- length(list.files(file.path(path_data, path_mri_id), pattern = ".png", full.names = TRUE))
})
#update rv
input_file_rv$nb_coupe <- nb_png
shinyjs::show("cut_selection")
input_file_rv$clear <- FALSE
output$contents <- renderUI({
valueBox(tags$p(paste0(as.character(nb_png), " coupes"), style = "font-size: 80%;"), "Nombre de coupes extraites du fichier nifti", icon = icon("brain", lib = "font-awesome"), color = "olive", width = NULL)
})
}
} else {
output$contents <- renderUI({NULL})
}
})
observe({
if (input_file_rv$nb_coupe == 0)
{
return(NULL)
} else {
}
output$cut_select_ui <- renderUI({
list_input <- seq(1, input_file_rv$nb_coupe, 1)
names(list_input) <- paste0("Coupe numéro ", list_input)
selectizeInput("cut_list", "Sélection des coupes à afficher :",
choices = list_input, selected = c("130", "135", "140", "145"), multiple = TRUE, options = list(maxItems = 4))})
})
observeEvent(input$click_visu_cut,{
withProgress(message = 'Sélection des png à afficher...',{
base_patient <- base_patient()
id_selected_patient <- base_patient[input$select_patient == id]$id
path_mri_id <- paste0("mri_id_", id_selected_patient)
list_png <- list.files(path = file.path(path_data, path_mri_id), pattern = ".png", full.names = TRUE)
list_png <- unlist(map(input$cut_list, ~list_png[grepl(pattern = ., list_png)]))
plist <- map(list_png, function(x) {ggdraw() + draw_image(x)})
})
output$image2 <- renderPlot({
plot_grid(plotlist = plist, labels = as.character(input$cut_list), label_size = 10, ncol = 4)
})
shinyjs::show("cut_visu")
})
observeEvent(input$launch_prev_2_class_irm,{
withProgress(message = 'Lancement de la prévision...',{
base_patient <- base_patient()
id_selected_patient <- base_patient[input$select_patient == id]$id
path_mri_id <- paste0("mri_id_", id_selected_patient)
if (!dir.exists(file.path(path_data, path_mri_id )))
{
print("attention il n'y a pas d'irm à prévoir pour ce patient")
output$prev = renderUI({
valueBox(tags$p("Attention", style = "font-size: 80%;"), subtitle = "Aucune IRM chargée pour ce patient", icon = icon("exclamation", lib = "font-awesome"), color = "yellow", width = 12)
})
} else {
#on lance la prev avec le bon modele
#on déplace les coupes
path_dir_pred <- file.path(path_data, "png_tmp")
file.remove(list.files(file.path(path_dir_pred, "to_pred"), pattern = ".png", full.names = TRUE, recursive = TRUE))
setProgress(value = 0.3 , message = "Extraction des png..")
cut_list<- c(144, 145, 146, 147)
list_png <- unlist(map(cut_list, ~list.files(file.path(path_data, path_mri_id ), pattern = paste0("z", ., ".png") , full.names = TRUE, recursive = TRUE)))
map(list_png, ~file.copy(from = ., to = file.path(path_dir_pred, "to_pred")))
### launch prev python ###
setProgress(value = 0.6 , message = "Prévision..")
reticulate::source_python(file.path(path_root, "inst/python/launch_2_class_pred.py"), envir = parent.frame(), convert = TRUE)
pred <- read.csv2(file.path(path_data, "models/2_class_irm/prev.csv"), header = FALSE, sep = "," , dec = ".")
pred <- as.matrix(pred)
mean_pred <- mean(pred)
if (mean_pred > 0.5) {
#lepatient est sain
output$prev = renderUI({
valueBox(tags$p("Patient sain", style = "font-size: 80%;"), paste0("Probabilité de non démence (moyenne des probabilités des 4 coupes) : ", round(100*mean_pred, 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
# output$prev = renderText({
# paste("<p style='color:green;'><b>sain</b> - Probabilité moyenne de : ", round(100*mean_pred, 2), "%")
})
} else {
output$prev = renderUI({
valueBox(tags$p("Patient atteint de démence", style = "font-size: 80%;"), paste0("Probabilité de démence (moyenne des probabilités des 4 coupes) : ", round(100*(1-mean_pred), 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
})
}
#browser()
#coupe 1
output$tab1_img <- renderImage({
list(src = list_png[1], width = "200")
}, deleteFile = FALSE)
output$val_tab1 <- renderUI({
if(pred[1] > 0.5) {
valueBox(tags$p(paste0(round(100*pred[1], 2), " %"), style = "font-size: 80%;"), "Probabilité de non démence", icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 8)
} else {
valueBox(tags$p(paste0(round(100*(1-pred[1]), 2), " %"), style = "font-size: 80%;"), "Probabilité de démence", icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 8)
}
})
#coupe 2
output$tab2_img <- renderImage({
list(src = list_png[2], width = "200")
}, deleteFile = FALSE)
output$val_tab2 <- renderUI({
if(pred[2] > 0.5) {
valueBox(tags$p(paste0(round(100*pred[2], 2), " %"), style = "font-size: 80%;"), "Probabilité de non démence", icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 8)
} else {
valueBox(tags$p(paste0(round(100*(1-pred[2]), 2), " %"), style = "font-size: 80%;"), "Probabilité de démence", icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 8)
}
})
#coupe 3
output$tab3_img <- renderImage({
list(src = list_png[3], width = "200")
}, deleteFile = FALSE)
output$val_tab3 <- renderUI({
if(pred[3] > 0.5) {
valueBox(tags$p(paste0(round(100*pred[3], 2), " %"), style = "font-size: 80%;"), "Probabilité de non démence", icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 8)
} else {
valueBox(tags$p(paste0(round(100*(1-pred[3]), 2), " %"), style = "font-size: 80%;"), "Probabilité de démence", icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 8)
}
})
#coupe 4
output$tab4_img <- renderImage({
list(src = list_png[4], width = "200")
}, deleteFile = FALSE)
output$val_tab4 <- renderUI({
if(pred[4] > 0.5) {
valueBox(tags$p(paste0(round(100*pred[4], 2), " %"), style = "font-size: 80%;"), "Probabilité de non démence", icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 8)
} else {
valueBox(tags$p(paste0(round(100*(1-pred[4]), 2), " %"), style = "font-size: 80%;"), "Probabilité de démence", icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 8)
}
})
output$pred_tabs <- renderUI(
tabsetPanel(
id = "tabs",
tabPanel(
"Coupe 1 (z = 142)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab1_img")
),
column(6,
uiOutput("val_tab1")
)
)
),
tabPanel(
"Coupe 2 (z = 144)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab2_img")
),
column(6,
uiOutput("val_tab2")
)
)
),
tabPanel(
"Coupe 3 (z = 146)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab3_img")
),
column(6,
uiOutput("val_tab3")
)
)
),
tabPanel(
"Coupe 4 (z = 148)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab4_img")
),
column(6,
uiOutput("val_tab4")
)
)
)
)
)
shinyjs::show("prev_coupe")
}
})
})
output$ggplot_var <- renderPlot({
diag_data$dementia_label<-factor(diag_data$dementia, labels=c("Absence de trouble","Présence de troubles"))
diag_data$CDR3_label<-factor(diag_data$CDR3, labels=c("Absence de trouble", "Troubles incertains", "Troubles bénins, modérés ou sévères"))
select_var = c("Age", "Taille", "Poids", "Entêtement", "Dépression", "Anxiété", "Apathie", "Désinhibé",
"Irritable", "Argent", "Factures", "Shopping", "Jeu", "Repas",
"Evénements", "Concentration", "Souvenir dates", "Déplacements", "Autonomie")
dt_var = c("age_at_diagnosis","TAILLE", "POIDS","ENTETEMENT","DEPRESS", "ANXIETE", "APATHIE", "DISINHIB",
"IRRITAB","ARGENT", "FACTURES","SHOPPING","JEU","REPAS","SOUV_EVENT","CONCENTRATION","SOUV_DATES", "DEPLACEMENT", "AUTONOMIE")
dt_corresp <- data.table(select_var = select_var, dt_var=dt_var)
var <- dt_corresp[select_var == input$select_var]$dt_var
if (input$select_var %in% c("Argent", "Factures", "Shopping", "Jeu", "Repas",
"Evénements", "Concentration", "Souvenir dates", "Déplacements")) {
labels_var <- c("Non","Il a rencontré des difficulté, mais a réussi seul",
"Il a eu besoin d'une aide","Il a été dépendant d'une tierce personne","Ne sait pas")
}
if (input$select_var %in% c("Entêtement", "Dépression", "Anxiété", "Apathie", "Désinhibé",
"Irritable")) {
labels_var <- c("Non","Oui")
}
if (input$select_var == "Autonomie") {
labels_var <- c("En capacité de vivre seul", "Requiert une assistance pour des activités particulièrement complexes", "Requiert une assistace pour des activités quotidiennes", "Dépendant", "Ne sait pas")
}
if (input$select_var == "Age") {
gg <- ggplot(diag_data[, .(CDR3_label , age_at_diagnosis )], aes(fill = CDR3_label, x= age_at_diagnosis)) + geom_density(alpha=0.4) + ggtitle("Distribution de l'âge au moment du diagnostic") +
scale_fill_discrete(name = "Démence :") + labs(x = "Age au moment du diagnostic", y = "Distribution") + theme_minimal() + theme(legend.position="bottom")
}
if (input$select_var == "Taille") {
gg <- ggplot(diag_data[, .(CDR3_label , TAILLE )], aes(fill = CDR3_label, x= TAILLE )) + geom_density(alpha=0.4) + ggtitle("Distribution de la taille des patients") +
scale_fill_discrete(name = "Démence :") + labs(x = "Taille du patient [cm]", y = "Distribution") + theme_minimal() + theme(legend.position="bottom")
}
if (input$select_var == "Poids") {
gg <- ggplot(diag_data[, .(CDR3_label , POIDS )], aes(fill = CDR3_label, x= POIDS )) + geom_density(alpha=0.4) + ggtitle("Distribution du poids des patients") +
scale_fill_discrete(name = "Démence :") + labs(x = "Poids du patient [Kg]", y = "Distribution") + theme_minimal() + theme(legend.position="bottom")
}
if (!input$select_var %in% c("Age", "Taille", "Poids")) {
gg_dt <- unique(diag_data[, .(Session , get(var), CDR3,CDR3_label)])
setnames(gg_dt, "V2", var)
gg_dt[,nb_cat := length(.SD$Session), by = c("CDR3", var)]
gg_dt[,nb_tot := length(.SD$Session), by = c("CDR3")]
gg_dt[, prop := nb_cat/nb_tot]
gg <- ggplot(unique(gg_dt[, .(get(var), CDR3_label, prop)]), aes(x = CDR3_label, y= prop, fill = V1)) + geom_bar(stat="identity", position=position_dodge()) + geom_label(aes(label = round(prop, 2)), position=position_dodge(.9), show.legend = FALSE, size = 5) +
theme_light() +
xlab("Démence") +
ylab("Proportion") +
labs(fill = "Réponse :") +
theme(
panel.grid = element_blank(),
panel.border = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank()
) +
scale_fill_brewer(labels = labels_var)+
theme(legend.position="bottom")
if (input$select_var == "Entêtement") {
gg <-gg + ggtitle("Le patient s'entête-t-il et refuse-t-il l'aide des autres ?")
}
if (input$select_var == "Dépression") {
gg <- gg + ggtitle("Le patient connait-il des épisodes de dépression ou de dysphorie ?")
}
if (input$select_var == "Anxiété") {
gg <- gg + ggtitle("Le patient est-il anxieux ?")
}
if (input$select_var == "Apathie") {
gg <-gg + ggtitle("Le patient est-il apathique ?")
}
if (input$select_var == "Désinhibé") {
gg <-gg + ggtitle("Le patient est-il désinhibé ?")
}
if (input$select_var == "Irritable") {
gg <-gg + ggtitle("Le patient est-il irritable ?")
}
if (input$select_var == "Argent") {
gg <-gg + ggtitle("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés ou besoin d'aide pour écrire un chèque, payer avec des billets... ?")
}
if (input$select_var == "Factures") {
gg <-gg + ggtitle("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés pour gérer ses papiers, payer ses factures, etc... ?")
}
if (input$select_var == "Shopping") {
gg <-gg + ggtitle("Dans les 4 dernières semaines, le patient a-t-il eu des difficultés pour faire ses courses ?")
}
if (input$select_var == "Jeu") {
gg <-gg + ggtitle("Dans les 4 dernières semaines, le patient a-t-il rencontré des difficultés pour jouer à un jeu de réflexion (bridge, échecs..) ?")
}
if (input$select_var == "Repas") {
gg <-gg + ggtitle("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés lors de la préparation d'un repas équilibré ?")
}
if (input$select_var == "Evénements") {
gg <-gg + ggtitle("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se rappeler d'événements courants ?")
}
if (input$select_var == "Concentration") {
gg <-gg + ggtitle("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se concentrer et à comprendre un programme TV, un livre ou un magazine ?")
}
if (input$select_var == "Souvenir dates") {
gg <-gg + ggtitle("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se souvenir de dates ?")
}
if (input$select_var == "Déplacements") {
gg <-gg + ggtitle("Durant les 4 dernières semaines, le patient a-t-il eu des difficultés à se déplacer\nen dehors de son quartier, à conduire, ou à prendre les transports en commun ?")
}
if (input$select_var == "Autonomie") {
gg <-gg + ggtitle("Quel est le niveau d'indépendance du patient ?")
}
}
return(gg)
})
#prevision base patient
observeEvent(input$launch_prev_2_class_patient,{
withProgress(message = 'Lancement de la prévision...',{
base_patient <- base_patient()
selected_patient <- base_patient[input$select_patient == id]
model <- dementiaproject::loadRData(list.files(path = file.path(path_data, "models", "2_class_patient"), pattern = ".Rdata", full.names = TRUE))
if (selected_patient$genre == "Homme") {
M_F <- "M"
} else {
M_F <- "F"
}
dt_2_pred <- data.table(dementia = NA,
age_at_diagnosis = selected_patient$age_at_diagnosis,
M.F = factor(M_F, levels = c("F", "M")),
TAILLE = selected_patient$size,
POIDS = selected_patient$weight,
AUTONOMIE = factor(selected_patient$independ, levels = as.character(c(1, 2, 3, 4, 9))),
ENTETEMENT = factor(as.numeric(selected_patient$agit), levels = as.character(c(0, 1))),
DEPRESS = factor(as.numeric(selected_patient$depress), levels = as.character(c(0, 1))),
ANXIETE = factor(as.numeric(selected_patient$anxiety), levels = as.character(c(0, 1))),
APATHIE = factor(as.numeric(selected_patient$apathy), levels = as.character(c(0, 1))),
DISINHIB = factor(as.numeric(selected_patient$disinhib), levels = as.character(c(0, 1))),
IRRITAB = factor(as.numeric(selected_patient$irr), levels = as.character(c(0, 1))),
ARGENT = factor(as.numeric(selected_patient$bills), levels = as.character(c(0, 1, 2, 3, 8))),
FACTURES = factor(as.numeric(selected_patient$taxes), levels = as.character(c(0, 1, 2, 3, 5, 8, 9))),
SHOPPING = factor(as.numeric(selected_patient$shopping), levels = as.character(c(0, 1, 2, 3, 8))),
JEU = factor(as.numeric(selected_patient$games), levels = as.character(c(0, 1, 2, 3, 8))),
REPAS = factor(as.numeric(selected_patient$meal), levels = as.character(c(0, 1, 2, 3, 8))),
SOUV_EVENT = factor(as.numeric(selected_patient$event), levels = as.character(c(0, 1, 2, 3, 8))),
CONCENTRATION = factor(as.numeric(selected_patient$concentration), levels = as.character(c(0, 1, 2, 3, 8))),
SOUV_DATES = factor(as.numeric(selected_patient$remdates), levels = as.character(c(0, 1, 2, 3, 8))),
DEPLACEMENT = factor(as.numeric(selected_patient$travel), levels = as.character(c(0, 1, 2, 3, 8))))
pred <- predict(model,newdata=dt_2_pred)
pred_prob <- predict(model,newdata=dt_2_pred, type = 'prob')
if (pred == 0) {
#le patient est sain
output$prev_patient = renderUI({
valueBox(tags$p("Patient sain (Absence de trouble - CDR = 0.0)", style = "font-size: 80%;"), paste0("Probabilité de non démence : ", round(100*pred_prob[,1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
})
} else {
output$prev_patient = renderUI({
valueBox(tags$p("Patient atteint de démence", style = "font-size: 80%;"), paste0("Probabilité de démence : ", round(100*pred_prob[,2], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
})
}
})
})
observeEvent(input$launch_prev_3_class_patient,{
withProgress(message = 'Lancement de la prévision...',{
base_patient <- base_patient()
selected_patient <- base_patient[input$select_patient == id]
model <- dementiaproject::loadRData(list.files(path = file.path(path_data, "models", "3_class_patient"), pattern = ".Rdata", full.names = TRUE))
if (selected_patient$genre == "Homme") {
M_F <- "M"
} else {
M_F <- "F"
}
dt_2_pred <- data.table(dementia = NA,
age_at_diagnosis = selected_patient$age_at_diagnosis,
M.F = factor(M_F, levels = c("F", "M")),
TAILLE = selected_patient$size,
POIDS = selected_patient$weight,
AUTONOMIE = factor(selected_patient$independ, levels = as.character(c(1, 2, 3, 4, 9))),
ENTETEMENT = factor(as.numeric(selected_patient$agit), levels = as.character(c(0, 1))),
DEPRESS = factor(as.numeric(selected_patient$depress), levels = as.character(c(0, 1))),
ANXIETE = factor(as.numeric(selected_patient$anxiety), levels = as.character(c(0, 1))),
APATHIE = factor(as.numeric(selected_patient$apathy), levels = as.character(c(0, 1))),
DISINHIB = factor(as.numeric(selected_patient$disinhib), levels = as.character(c(0, 1))),
IRRITAB = factor(as.numeric(selected_patient$irr), levels = as.character(c(0, 1))),
ARGENT = factor(as.numeric(selected_patient$bills), levels = as.character(c(0, 1, 2, 3, 8))),
FACTURES = factor(as.numeric(selected_patient$taxes), levels = as.character(c(0, 1, 2, 3, 5, 8, 9))),
SHOPPING = factor(as.numeric(selected_patient$shopping), levels = as.character(c(0, 1, 2, 3, 8))),
JEU = factor(as.numeric(selected_patient$games), levels = as.character(c(0, 1, 2, 3, 8))),
REPAS = factor(as.numeric(selected_patient$meal), levels = as.character(c(0, 1, 2, 3, 8))),
SOUV_EVENT = factor(as.numeric(selected_patient$event), levels = as.character(c(0, 1, 2, 3, 8))),
CONCENTRATION = factor(as.numeric(selected_patient$concentration), levels = as.character(c(0, 1, 2, 3, 8))),
SOUV_DATES = factor(as.numeric(selected_patient$remdates), levels = as.character(c(0, 1, 2, 3, 8))),
DEPLACEMENT = factor(as.numeric(selected_patient$travel), levels = as.character(c(0, 1, 2, 3, 8))))
pred <- predict(model,newdata=dt_2_pred)
pred_prob <- predict(model,newdata=dt_2_pred, type = 'prob')
if (pred == 0) {
#le patient est sain
output$prev_patient = renderUI({
valueBox(tags$p("Patient sain (Absence de trouble - CDR = 0.0)", style = "font-size: 60%;"), paste0("Probabilité : ", round(100*pred_prob[,1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
})
}
if (pred == 1) {
output$prev_patient = renderUI({
valueBox(tags$p("Patient possiblement atteint (Troubles incertains - CDR = 0.5)", style = "font-size: 60%;"), paste0("Probabilité : ", round(100*pred_prob[,2], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "yellow", width = 12)
})
}
if (pred == 2) {
output$prev_patient = renderUI({
valueBox(tags$p("Patient atteint (Troubles bénins, modérés ou sévères - CDR >= 1.0)", style = "font-size: 60%;"), paste0("Probabilité : ", round(100*pred_prob[,3], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
})
}
})
})
observeEvent(input$launch_prev_3_class_irm,{
withProgress(message = 'Lancement de la prévision...',{
base_patient <- base_patient()
id_selected_patient <- base_patient[input$select_patient == id]$id
path_mri_id <- paste0("mri_id_", id_selected_patient)
if (!dir.exists(file.path(path_data, path_mri_id )))
{
print("attention il n'y a pas d'irm à prévoir pour ce patient")
output$prev = renderUI({
valueBox(tags$p("Attention", style = "font-size: 80%;"), subtitle = "Aucune IRM chargée pour ce patient", icon = icon("exclamation", lib = "font-awesome"), color = "yellow", width = 12)
})
} else {
#on lance la prev avec le bon modele
#on déplace les coupes
path_dir_pred <- file.path(path_data, "png_tmp")
file.remove(list.files(file.path(path_dir_pred, "to_pred"), pattern = ".png", full.names = TRUE, recursive = TRUE))
setProgress(value = 0.3 , message = "Extraction des png..")
if (file.exists(file.path(path_data,'/models/3_class_irm/prev.csv'))) {
file.remove(file.path(path_data, '/models/3_class_irm/prev.csv'))
}
cut_list<- c(152, 153, 154, 155)
list_png <- unlist(map(cut_list, ~list.files(file.path(path_data, path_mri_id ), pattern = paste0("z", ., ".png") , full.names = TRUE, recursive = TRUE)))
map(list_png, ~file.copy(from = ., to = file.path(path_dir_pred, "to_pred")))
### launch prev python ###
reticulate::source_python(file.path(path_root, "inst/python/launch_3_class_pred.py"), envir = parent.frame(), convert = TRUE)
pred <- read.csv2(file.path(path_data, "models/3_class_irm/prev.csv"), header = FALSE, sep = "," , dec = ".")
pred <- as.matrix(pred)
mean_pred <- c(mean(pred[,1]), mean(pred[,2]), mean(pred[,3]))
n_max <- which.max(mean_pred)
if (n_max == 1) {
output$prev = renderUI({
valueBox(tags$p("Patient sain (Absence de trouble - CDR = 0.0)", style = "font-size: 60%;"), paste0("Probabilité (moyenne des probabilités des 4 coupes) : ", round(100*mean_pred[n_max], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
})
}
if (n_max == 2) {
output$prev = renderUI({
valueBox(tags$p("Patient possiblement atteint (Troubles incertains - CDR = 0.5)", style = "font-size: 60%;"), paste0("Probabilité (moyenne des probabilités des 4 coupes) : ", round(100*mean_pred[n_max], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "yellow", width = 12)
})
}
if (n_max == 3) {
output$prev = renderUI({
valueBox(tags$p("Patient atteint de démence (Troubles bénins, modérés ou sévères - CDR >= 1.0)", style = "font-size: 60%;"), paste0("Probabilité (moyenne des probabilités des 4 coupes) : ", round(100*mean_pred[n_max], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
})
}
#coupe 1
output$tab1_img <- renderImage({
list(src = list_png[1], width = "200")
}, deleteFile = FALSE)
output$val_tab1 <- renderUI({
max_1 <- which.max(pred[1,])
if (max_1 == 1) {
vb <- valueBox(tags$p("Sain", style = "font-size: 60%;"), paste0("Probabilité (Absence de trouble) : ", round(100*pred[1,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
}
if (max_1 == 2) {
vb <-valueBox(tags$p("Possiblement atteint", style = "font-size: 60%;"), paste0("Probabilité (Troubles incertains) : ", round(100*pred[1,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "yellow", width = 12)
}
if (max_1 == 3) {
vb <-valueBox(tags$p("Atteint de démence", style = "font-size: 60%;"), paste0("Probabilité (Troubles bénins, modérés ou sévères) : ", round(100*pred[1,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
}
return(vb)
})
output$val_tab2 <- renderUI({
max_1 <- which.max(pred[2,])
if (max_1 == 1) {
vb <- valueBox(tags$p("Sain", style = "font-size: 60%;"), paste0("Probabilité (Absence de trouble) : ", round(100*pred[2,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
}
if (max_1 == 2) {
vb <- valueBox(tags$p("Possiblement atteint", style = "font-size: 60%;"), paste0("Probabilité (Troubles incertains) : ", round(100*pred[2,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "yellow", width = 12)
}
if (max_1 == 3) {
vb <- valueBox(tags$p("Atteint de démence", style = "font-size: 60%;"), paste0("Probabilité (Troubles bénins, modérés ou sévères) : ", round(100*pred[2,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
}
return(vb)
})
output$val_tab3 <- renderUI({
max_1 <- which.max(pred[3,])
if (max_1 == 1) {
vb <- valueBox(tags$p("Sain", style = "font-size: 60%;"), paste0("Probabilité (Absence de trouble) : ", round(100*pred[3,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
}
if (max_1 == 2) {
vb <- valueBox(tags$p("Possiblement atteint", style = "font-size: 60%;"), paste0("Probabilité (Troubles incertains) : ", round(100*pred[3,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "yellow", width = 12)
}
if (max_1 == 3) {
vb <- valueBox(tags$p("Atteint de démence", style = "font-size: 60%;"), paste0("Probabilité (Troubles bénins, modérés ou sévères) : ", round(100*pred[3,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
}
return(vb)
})
output$val_tab4 <- renderUI({
max_1 <- which.max(pred[4,])
if (max_1 == 1) {
vb <- valueBox(tags$p("Sain", style = "font-size: 60%;"), paste0("Probabilité (Absence de trouble) : ", round(100*pred[4,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "olive", width = 12)
}
if (max_1 == 2) {
vb <- valueBox(tags$p("Possiblement atteint", style = "font-size: 60%;"), paste0("Probabilité (Troubles incertains) : ", round(100*pred[4,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "yellow", width = 12)
}
if (max_1 == 3) {
vb <- valueBox(tags$p("Atteint de démence", style = "font-size: 60%;"), paste0("Probabilité (Troubles bénins, modérés ou sévères) : ", round(100*pred[4,][max_1], 2), " %"), icon = icon("stethoscope", lib = "font-awesome"), color = "red", width = 12)
}
return(vb)
})
#coupe 2
output$tab2_img <- renderImage({
list(src = list_png[2], width = "200")
}, deleteFile = FALSE)
#coupe 3
output$tab3_img <- renderImage({
list(src = list_png[3], width = "200")
}, deleteFile = FALSE)
#coupe 4
output$tab4_img <- renderImage({
list(src = list_png[4], width = "200")
}, deleteFile = FALSE)
output$pred_tabs <- renderUI(
tabsetPanel(
id = "tabs",
tabPanel(
"Coupe 1 (z = 138)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab1_img")
),
column(6,
uiOutput("val_tab1")
)
)
),
tabPanel(
"Coupe 2 (z = 140)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab2_img")
),
column(6,
uiOutput("val_tab2")
)
)
),
tabPanel(
"Coupe 3 (z = 142)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab3_img")
),
column(6,
uiOutput("val_tab3")
)
)
),
tabPanel(
"Coupe 4 (z = 144)",
fluidRow(
br(),
column(6, align="center",
imageOutput("tab4_img")
),
column(6,
uiOutput("val_tab4")
)
)
)
)
)
shinyjs::show("prev_coupe")
}
})
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.