Merge branch 'main' of https://github.com/oxford-pharmacoepi/PETDiagn…

…ostics
oxford-pharmacoepi · Dec 23, 2022 · e9b753b · e9b753b
2 parents 4dfaeff + 5c5984e
commit e9b753b
Show file tree

Hide file tree

Showing 36 changed files with 1,147 additions and 98 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -24,8 +24,10 @@ Imports:
     glue,
     lubridate,
     magrittr,
+    misty,
     reshape2,
     rlang,
+    stats,
     tibble,
     zip
 VignetteBuilder: knitr
diff --git a/NAMESPACE b/NAMESPACE
@@ -5,8 +5,13 @@ export(checkFetusId)
 export(checkFetusesLiveborn)
 export(checkOutcomeMode)
 export(executeChecks)
+export(getAnnualOverview)
+export(getBitSet)
 export(getMissings)
 export(getOverview)
+export(getUnknown)
+export(getValueDatesAgeDist)
+export(getValueWeightDist)
 export(mockPregnancy)
 export(summariseGestationalAge)
 export(writeResultToDisk)

diff --git a/R/checkFetusId.R b/R/checkFetusId.R
@@ -3,7 +3,7 @@
 #' @param motherTable is the motherTable
 #' @param babyTable is the babyTable
 #'
-#' @return returns a tale with the fetuses checks
+#' @return returns a table with the fetuses checks
 #' @export
 #'
 #' @examples
@@ -35,11 +35,14 @@ records<- recordshelp %>% dplyr::left_join((recordshelp %>% dplyr::group_by(.dat
 #add fetus count to pregnancy
 recordshelp <- NULL
 
+
 records<- records %>% dplyr::mutate(
 
-  single_not_align_with_noOfFetusId = dplyr::if_else((.data$n > 1  &  .data$pregnancy_single == 4188539) | (.data$n == 1  &  .data$pregnancy_single == 4188540),1,0,missing = NULL),
+  single_not_align_with_noOfFetusId = ifelse(.data$pregnancy_single !=0 ,dplyr::if_else(
+       (.data$n > 1  &  .data$pregnancy_single == 4188539) | (.data$n == 1  &  .data$pregnancy_single == 4188540),1,0,missing = NULL),NA),
 
-  single_align_with_noOfFetusId = dplyr::if_else((.data$n > 1  &  .data$pregnancy_single == 4188540) | (.data$n == 1  &  .data$pregnancy_single == 4188539) ,1,0,missing = NULL),
+  single_align_with_noOfFetusId = ifelse(.data$pregnancy_single !=0 , dplyr::if_else(
+    (.data$n > 1  &  .data$pregnancy_single == 4188540) | (.data$n == 1  &  .data$pregnancy_single == 4188539),1,0,missing = NULL),NA),
 
   noOfFetus_not_align_with_noOfFetusId = dplyr::if_else((.data$pregnancy_number_fetuses  != .data$n ),1,0,missing = NULL),
 
@@ -56,13 +59,13 @@ records_n <- records %>%
 
                    single_align_with_noOfFetusId = sum(.data$single_align_with_noOfFetusId, na.rm = T),
 
-                   missing_single = sum(is.na(.data$pregnancy_single)), #n cannot be missing
+                   missingUnknown_single = sum(is.na(.data$pregnancy_single)),
 
                    noOfFetus_not_align_with_noOfFetusId = sum(.data$noOfFetus_not_align_with_noOfFetusId, na.rm = T),
 
                    noOfFetus_align_with_noOfFetusId = sum(.data$noOfFetus_align_with_noOfFetusId, na.rm = T),
 
-                   missing_noOfFetus = sum(is.na(.data$pregnancy_number_fetuses)) #n cannot be missing
+                   missing_noOfFetus = sum(is.na(.data$pregnancy_number_fetuses))
 
 
   )
@@ -74,7 +77,7 @@ records_prop <- records_n %>%
 
     single_align_with_noOfFetusId = round(.data$single_align_with_noOfFetusId /nrow(tibble::as_tibble(motherTable)),3)*100,
 
-    missing_single = round(.data$missing_single /nrow(tibble::as_tibble(motherTable)),3)*100,
+    missingUnknown_single = round(.data$missingUnknown_single /nrow(tibble::as_tibble(motherTable)),3)*100,
 
     noOfFetus_not_align_with_noOfFetusId = round(.data$noOfFetus_not_align_with_noOfFetusId / nrow(tibble::as_tibble(motherTable)),3)*100,
 

diff --git a/R/checkOutcomeMode.R b/R/checkOutcomeMode.R
@@ -23,8 +23,9 @@ checkOutcomeMode <- function(
 
   #check if miscarriage or TOP has vaginal or c-section delivery
    records <- records %>% dplyr::mutate(
-    n = dplyr::if_else(((.data$pregnancy_outcome == 4067106 | .data$pregnancy_outcome == 4081422)
-                           & (.data$pregnancy_mode_delivery == 4125611 | .data$pregnancy_mode_delivery ==4015701)),1,0,missing = NULL)) %>%
+    n = dplyr::if_else(.data$pregnancy_outcome !=0 , dplyr::if_else(
+      (.data$pregnancy_outcome == 4067106 | .data$pregnancy_outcome == 4081422)
+                           & (.data$pregnancy_mode_delivery == 4125611 | .data$pregnancy_mode_delivery ==4015701),1,0,missing = NULL),NA,missing = NULL)) %>%
      dplyr::collect()
 
   records_n <- records %>%
@@ -33,7 +34,7 @@ checkOutcomeMode <- function(
 
                      match = sum(.data$n==0, na.rm = T),
 
-                     missing_information = sum(is.na(.data$n)),
+                     missingUnknown_information = sum(is.na(.data$n)),
 
                      )
   records_prop <- records_n %>%
@@ -43,7 +44,7 @@ checkOutcomeMode <- function(
 
       match = round(.data$match / nrow(tibble::as_tibble(workTable)),3)*100,
 
-      missing_information = round(.data$missing_information /nrow(tibble::as_tibble(workTable)),3)*100)
+      missingUnknown_information = round(.data$missingUnknown_information /nrow(tibble::as_tibble(workTable)),3)*100)
 
 
 records_n <- tibble::as_tibble(reshape2::melt(records_n,variable.names="variable",value.name = "count"))

diff --git a/R/executeChecks.R b/R/executeChecks.R
@@ -13,8 +13,8 @@
 executeChecks <- function(#cdm,
                           motherTable = NULL,
                           babyTable = NULL,
-                          checks = c("overview", "missing", "gestationalAge", "outcomeMode", "fetusesLiveborn",
-                                     "fetusid"),
+                          checks = c("overview","annualOverview","missing", "unknown","gestationalAge","datesAgeDist","outcomeMode", "fetusesLiveborn",
+                                     "fetusid","weightDist","bitSet"),
                           minCellCount = 5,
                           verbose = FALSE) {
 
@@ -48,6 +48,17 @@ executeChecks <- function(#cdm,
   }
 
 
+  if ("annualOverview" %in% checks) {
+    if (verbose == TRUE) {
+      start <- printDurationAndMessage("Progress: total number of women, pregnancies (and fetuses) per year", start)
+    }
+    if (!is.null(motherTable)) {
+      AnnualPETOverviewMother <- NULL
+      AnnualPETOverviewMother <- getAnnualOverview(motherTable) %>% dplyr::collect()
+    }
+
+  }
+
 
   if ("missing" %in% checks) {
     if (verbose == TRUE) {
@@ -64,51 +75,110 @@ executeChecks <- function(#cdm,
   }
 
 
-  gestationalAgeMatch <-  NULL
+  if ("unknown" %in% checks) {
+    if (verbose == TRUE) {
+      start <- printDurationAndMessage("Progress: check unknowns of required variables", start)
+    }
+    if (!is.null(motherTable)) {
+      unknownSummaryMother <- NULL
+      unknownSummaryMother <- getUnknown(motherTable) %>% dplyr::collect()
+    }
+
+  }
+
+
   if ("gestationalAge" %in% checks) {
     if (verbose == TRUE) {
       start <- printDurationAndMessage("Progress: check Gestational Age", start)
     }
     if (!is.null(motherTable)) {
+  gestationalAgeMatch <-  NULL
   gestationalAgeMatch <- summariseGestationalAge(motherTable) %>% dplyr::collect()
     }
   }
 
-  outcomeModeMatch <-  NULL
+
+
+  if ("datesAgeDist" %in% checks) {
+    if (verbose == TRUE) {
+      start <- printDurationAndMessage("Progress: check values of dates and Gestational Age", start)
+    }
+    if (!is.null(motherTable)) {
+      valueDatesAgeDist <-  NULL
+      valueDatesAgeDist <- getValueDatesAgeDist(motherTable) %>% dplyr::collect()
+    }
+  }
+
+
+
   if ("outcomeMode" %in% checks) {
     if (verbose == TRUE) {
       start <- printDurationAndMessage("Progress: check Outcome and Mode of Delivery", start)
     }
     if (!is.null(motherTable)) {
+   outcomeModeMatch <-  NULL
    outcomeModeMatch <- checkOutcomeMode(motherTable) %>% dplyr::collect()
     }
   }
 
-  fetusesLivebornNumber <-  NULL
+
   if ("fetusesLiveborn" %in% checks) {
     if (verbose == TRUE) {
       start <- printDurationAndMessage("Progress: check number of fetuses versus liveborn", start)
     }
 # pregnancy_single is a required variable
     if ("pregnancy_number_fetuses" %in% colnames(motherTable) && "pregnancy_number_liveborn" %in% colnames(motherTable)) {
+      fetusesLivebornNumber <-  NULL
    fetusesLivebornNumber <- tibble::as_tibble(checkFetusesLiveborn(motherTable)) %>% dplyr::collect()
     }
   }
 
 
-  fetusIdMatch <- NULL
+
   if ("fetusid" %in% checks) {
     if (verbose == TRUE) {
       start <- printDurationAndMessage("Progress: check number of fetuses versus liveborn", start)
     }
-    if (!is.null(motherTable) && "fetus_id" %in% colnames(babyTable)) {
-
+    if (!is.null(motherTable) && !is.null(babyTable)) {
+      fetusIdMatch <- NULL
    fetusIdMatch <- checkFetusId(motherTable,babyTable) %>% dplyr::collect()
       }
 
   }
 
 
+  if ("weightDist" %in% checks) {
+    if (verbose == TRUE) {
+      start <- printDurationAndMessage("Progress: check values of birthweight", start)
+    }
+    if (!is.null(babyTable)) {
+      valueWeightDist <- NULL
+      valueWeightDist <- getValueWeightDist(babyTable) %>% dplyr::collect()
+    }
+
+  }
+
+
+
+
+  if ("bitSet" %in% checks) {
+    if (verbose == TRUE) {
+      start <- printDurationAndMessage("Progress: check missing/unknown data pattern", start)
+    }
+    if (!is.null(motherTable) && !is.null(babyTable)) {
+      bitSetOverviewAll <- NULL
+      bitSetOverviewAll  <- getBitSet(motherTable,babyTable) %>% dplyr::collect()
+    } else if (!is.null(motherTable)) {
+        bitSetOverviewMother <- NULL
+        bitSetOverviewMother  <- getBitSet(motherTable, babyTable = NULL) %>% dplyr::collect()
+      } else if (!is.null(babyTable)) {
+        bitSetOverviewBaby <- NULL
+        bitSetOverviewBaby  <- getBitSet(motherTable = NULL, babyTable) %>% dplyr::collect()
+      }
+    }
+
+
+
    if (verbose == TRUE) {
     start <- printDurationAndMessage("Finished", start)
   }
@@ -118,26 +188,38 @@ executeChecks <- function(#cdm,
   if (!is.null(motherTable) && !is.null(babyTable)) {
 
   result <- list("PETOverviewMother" = PETOverviewMother,
+                 "AnnualPETOverviewMother" = AnnualPETOverviewMother,
                  "PETOverviewBaby" = PETOverviewBaby,
                  "missingSummaryMother" = missingSummaryMother,
                  "missingSummaryBaby" = missingSummaryBaby,
+                 "unknownSummaryMother" = unknownSummaryMother,
                  "gestationalAgeMatch" = gestationalAgeMatch,
+                 "valueDatesAgeDist" =  valueDatesAgeDist,
                  "outcomeModeMatch" = outcomeModeMatch,
                  "fetusesLivebornNumber" = fetusesLivebornNumber,
-                 "fetusIdMatch" = fetusIdMatch)
+                 "fetusIdMatch" = fetusIdMatch,
+                 "valueWeightDist" = valueWeightDist,
+                 "bitSetOverviewAll" =  bitSetOverviewAll
+                 )
 
   } else if  (!is.null(motherTable)) {
 
     result <- list("PETOverviewMother" = PETOverviewMother,
+                   "AnnualPETOverviewMother" = AnnualPETOverviewMother,
                    "missingSummaryMother" = missingSummaryMother,
+                   "unknownSummaryMother" = unknownSummaryMother,
                    "gestationalAgeMatch" = gestationalAgeMatch,
+                   "valueDatesAgeDist" =  valueDatesAgeDist,
                    "outcomeModeMatch" = outcomeModeMatch,
-                   "fetusesLivebornNumber" = fetusesLivebornNumber)
+                   "fetusesLivebornNumber" = fetusesLivebornNumber,
+                   "bitSetOverviewMother" =  bitSetOverviewMother)
 
   }   else  if  (!is.null(babyTable)) {
 
     result <- list("PETOverviewBaby" = PETOverviewBaby,
-                   "missingSummaryBaby" = missingSummaryBaby)
+                   "missingSummaryBaby" = missingSummaryBaby,
+                   "valueWeightDist" = valueWeightDist,
+                   "bitSetOverviewBaby" =  bitSetOverviewBaby)
 
   }
 

diff --git a/R/getAnnualOverview.R b/R/getAnnualOverview.R
@@ -0,0 +1,38 @@
+
+#' Title
+#'
+#' @param motherTable is the motherTable
+#'
+#' @return a table which shows the number of pregnancies per year
+#' @export
+#'
+#' @examples
+getAnnualOverview <- function(
+    motherTable
+)
+{
+
+  # checks
+  errorMessage <- checkmate::makeAssertCollection()
+  #checkDbType(cdm = cdm, messageStore = errorMessage)
+  checkmate::assertTRUE(inherits(motherTable, 'tbl_dbi'), add = errorMessage)
+  checkmate::reportAssertions(collection = errorMessage)
+
+
+    records <- motherTable %>%
+      dplyr::select(
+        "pregnancy_id",
+        "pregnancy_end_date"
+      ) %>% dplyr::collect()
+
+    records <- records %>%
+      dplyr::mutate(
+        year = format(.data$pregnancy_end_date, "%Y")
+      )   %>% dplyr::group_by(.data$year)  %>%
+      dplyr::summarise(
+       pregnancies = dplyr::n_distinct(.data$pregnancy_id)
+      )
+
+  return(records)
+
+}