feat: added age at diagnosis

Oliversinn · Dec 31, 2023 · 4742c2b · 4742c2b
1 parent f6baba9
commit 4742c2b
Show file tree

Hide file tree

Showing 3 changed files with 157 additions and 25 deletions.
diff --git a/Dashboard/diagnosis.R b/Dashboard/diagnosis.R
@@ -33,7 +33,6 @@ primary_diagnosis_treemap <- function(data) {
       )
     )
 
-  # primary_diagnosis_treemap ----
   primary_diagnosis_treemap <- plot_ly(
     data = primary_diagnosis_tree_df,
     branchvalues = "total",
@@ -48,7 +47,7 @@ primary_diagnosis_treemap <- function(data) {
   return(primary_diagnosis_treemap)
 }
 
-
+# primary_diagnosis_treedt ----
 primary_diagnosis_treedt <- function(data) {
   data <- data %>% 
     group_by(tissue_or_organ_of_origin, primary_diagnosis) %>% 
@@ -118,7 +117,6 @@ pathologic_stage_treemap <- function(data) {
       )
     )
 
-  # ajcc_pathologic_stage_treemap ----
   ajcc_pathologic_stage_treemap <- plot_ly(
     data = ajcc_pathologic_stage_tree_df,
     branchvalues = "total",
@@ -132,6 +130,7 @@ pathologic_stage_treemap <- function(data) {
   return(ajcc_pathologic_stage_treemap)
 }
 
+# pathologic_stage_treedt ----
 pathologic_stage_treedt <- function(data) {
   data <- data %>% 
     group_by(tissue_or_organ_of_origin, ajcc_pathologic_stage) %>% 
@@ -300,11 +299,11 @@ primary_diagnosis_bardt <- function(data) {
         buttons = list(
           list(
             extend = "csv",
-            filename = "casos_por_tejido_de_origen"
+            filename = "casos_por_diagnostico_primario"
           ),
           list(
             extend = "excel",
-            filename = "casos_por_tejido_de_origen"
+            filename = "casos_por_diagnostico_primario"
           )
         ),
         paging = FALSE,
@@ -370,11 +369,102 @@ pathologic_stage_bardt <- function(data) {
         buttons = list(
           list(
             extend = "csv",
-            filename = "casos_por_tejido_de_origen"
+            filename = "casos_por_etapa_patologica"
           ),
           list(
             extend = "excel",
-            filename = "casos_por_tejido_de_origen"
+            filename = "casos_por_etapa_patologica"
+          )
+        ),
+        paging = FALSE,
+        scrollY = "400px",
+        scrollX = TRUE
+      )
+    )
+  return(data)
+}
+
+# age_at_diagnosis_bar ----
+age_at_diagnosis_bar <- function(data) {
+  fig <- data %>% 
+    mutate(
+      age = age_at_diagnosis_years,
+      `Edad al diagnostico` = age_categories(
+        age,
+        breakers = c(
+          0, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, 85, 90
+        )
+      )
+    ) %>% 
+    group_by(`Edad al diagnostico`) %>% 
+    tally(name = "Casos") %>% 
+    mutate(
+      `Edad al diagnostico` = as.character(`Edad al diagnostico`)
+    ) %>% 
+    replace(is.na(.), "Sin dato") %>% 
+    mutate(
+      `Edad al diagnostico` = factor(`Edad al diagnostico`)
+    ) %>% 
+    plot_ly(
+      x = ~`Edad al diagnostico`, y = ~`Casos`, type = "bar"
+    ) %>%
+    layout(
+      xaxis = list(
+        title = "Edad al diagnóstico"
+      ),
+      yaxis = list(
+        title = "Número de casos"
+      )
+    ) %>%
+    config(
+      displaylogo = FALSE,
+      modeBarButtonsToRemove = c(
+        "sendDataToCloud", "editInChartStudio", "pan2d", "select2d",
+        "drawclosedpath", "drawline", "drawrect", "drawopenpath",
+        "drawcircle", "eraseshape", "zoomIn2d", "zoomOut2d", "toggleSpikelines",
+        "lasso2d"
+      )
+    )
+  return(fig)
+}
+
+# age_at_diagnosis_bardt ----
+age_at_diagnosis_bardt <- function(data) {
+  data <- data %>% 
+    mutate(
+      age = age_at_diagnosis_years,
+      `Edad al diagnostico` = age_categories(
+        age,
+        breakers = c(
+          0, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, 85, 90
+        )
+      )
+    ) %>% 
+    group_by(`Edad al diagnostico`) %>% 
+    tally(name = "Casos") %>% 
+    mutate(
+      `Edad al diagnostico` = as.character(`Edad al diagnostico`)
+    ) %>% 
+    replace(is.na(.), "Sin dato") %>% 
+    mutate(
+      `Edad al diagnostico` = factor(`Edad al diagnostico`)
+    ) %>% 
+    datatable(
+      extensions = "Buttons",
+      rownames = FALSE,
+      options = list(
+        language = list(
+          url = "//cdn.datatables.net/plug-ins/1.13.7/i18n/es-ES.json"
+        ),
+        dom = "Bfrtip",
+        buttons = list(
+          list(
+            extend = "csv",
+            filename = "casos_por_edad_al_diagnostico"
+          ),
+          list(
+            extend = "excel",
+            filename = "casos_por_edad_al_diagnostico"
           )
         ),
         paging = FALSE,

diff --git a/Dashboard/server.R b/Dashboard/server.R
@@ -730,6 +730,26 @@ function(input, output, session) {
     )
   })
 
+  #### age_at_diagnosis_bar ----
+  output$age_at_diagnosis_bar <- renderPlotly({
+    age_at_diagnosis_bar(
+      combined_diagnoses_reactive() %>% 
+        dplyr::filter(
+          case_id %in% case_ids$case_id
+        )
+    )
+  })
+
+  #### age_at_diagnosis_bardt ----
+  output$age_at_diagnosis_bardt <- DT::renderDataTable({
+    age_at_diagnosis_bardt(
+      combined_diagnoses_reactive() %>% 
+        dplyr::filter(
+          case_id %in% case_ids$case_id
+        )
+    )
+  })
+
 
   # Explorer data ----
   explorer_data_reactive <- reactive({

diff --git a/Dashboard/ui.R b/Dashboard/ui.R
@@ -71,24 +71,6 @@ fluidPage(
           "Seleccionar un tipo de enfermedad",
           placement = "right", trigger = "hover", options = NULL
         ),
-        ### age_at_diagnosis ----
-        sliderInput(
-          "age_at_diagnosis",
-          label = "Edad al diagnostico",
-          min = min_diagnosis_age,
-          max = max_diagnosis_age,
-          value = c(min_diagnosis_age,max_diagnosis_age)
-        ),
-        bsTooltip(
-          "disease_type",
-          "Seleccionar un rango de edad",
-          placement = "right", trigger = "hover", options = NULL
-        ),
-        checkboxInput(
-          "age_at_diagnosis_na",
-          "Incluir NAs en Edad al diagnositico",
-          value = TRUE
-        ),
         ### tissue_or_organ_of_origin ----
         selectInput(
           "tissue_or_organ_of_origin",
@@ -125,6 +107,24 @@ fluidPage(
           "Seleccionar una etapa patológica",
           placement = "right", trigger = "hover", options = NULL
         ),
+        ### age_at_diagnosis ----
+        sliderInput(
+          "age_at_diagnosis",
+          label = "Edad al diagnostico",
+          min = min_diagnosis_age,
+          max = max_diagnosis_age,
+          value = c(min_diagnosis_age,max_diagnosis_age)
+        ),
+        bsTooltip(
+          "disease_type",
+          "Seleccionar un rango de edad",
+          placement = "right", trigger = "hover", options = NULL
+        ),
+        checkboxInput(
+          "age_at_diagnosis_na",
+          "Incluir NAs en Edad al diagnositico",
+          value = TRUE
+        ),
         ## Initial tab ----
         menuItem(
           text = "Explorador",
@@ -404,6 +404,28 @@ fluidPage(
                       DT::dataTableOutput("pathologic_stage_bardt"),
                       color = "#1c9ad6", type = "8", size = 0.5
                     )
+                  ),
+                  ### pathologic_stage_bar ----
+                  tabPanel(
+                    title = "Gráfico de barras por edad al diagnóstico",
+                    icon = icon("chart-bar"),
+                    h4(
+                      class = "text-center",
+                      "Número de Casos por Etapa Patológica"
+                    ),
+                    shinycssloaders::withSpinner(
+                      plotlyOutput("age_at_diagnosis_bar", height = 500),
+                      color = "#1c9ad6", type = "8", size = 0.5
+                    )
+                  ),
+                  ### pathologic_stage_bardt ----
+                  tabPanel(
+                    title = "Cuadro de datos por edad al diagnóstico",
+                    icon = icon("table"),
+                    shinycssloaders::withSpinner(
+                      DT::dataTableOutput("age_at_diagnosis_bardt"),
+                      color = "#1c9ad6", type = "8", size = 0.5
+                    )
                   )
                 )
               )