In sarahvanhala/nomscheck: Report to Check NOMS Data

knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)

Comparing new data values to reference distributions

The following plots show the new values of certain variables compared to reference distributions.

library(nomscheck)
library(readr)
library(dplyr)
library(DT)

noms_data <- read_noms_data(params$noms_data_path)
new_data <- noms_data

if (file.exists(params$prior_assessments_path)) {
  prior_assessments <- read_csv(params$prior_assessments_path, col_types = "cdd")

  new_data <- noms_data %>%
    anti_join(prior_assessments, by = c("ConsumerID", "Assessment", "der_intake_seq_no"))
}

new_data <- new_data %>%
  filter(Assessment != 699)

BPressure_s

compare_dist(new_data, "BPressure_s")

The following is a table of the values of BPressure_s shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, BPressure_s) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

BPressure_d

compare_dist(new_data, "BPressure_d")

The following is a table of the values of BPressure_d shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, BPressure_d) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Weight

compare_dist(new_data, "Weight")

The following is a table of the values of Weight shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, Weight) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Height

compare_dist(new_data, "Height")

The following is a table of the values of Height shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, Height) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

WaistCircum

compare_dist(new_data, "WaistCircum")

The following is a table of the values of WaistCircum shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, WaistCircum) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

BreathCO

compare_dist(new_data, "BreathCO")

The following is a table of the values of BreathCO shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, BreathCO) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Plasma_Gluc

compare_dist(new_data, "Plasma_Gluc")

The following is a table of the values of Plasma_Gluc shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, Plasma_Gluc) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

HgbA1c

compare_dist(new_data, "HgbA1c")

The following is a table of the values of HgbA1c shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, HgbA1c) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Lipid_TotChol

compare_dist(new_data, "Lipid_TotChol")

Table

The following is a table of the values of Lipid_TotChol shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, Lipid_TotChol) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Lipid_HDL

compare_dist(new_data, "Lipid_HDL")

The following is a table of the values of Lipid_HDL shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, Lipid_HDL) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Lipid_Tri

compare_dist(new_data, "Lipid_Tri")

The following is a table of the values of Lipid_Tri shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, Lipid_Tri) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Lipid_LDL

compare_dist(new_data, "Lipid_LDL")

The following is a table of the values of Lipid_LDL shown in the plot above for the new observations.

new_data %>%
  select(ConsumerID, Assessment, der_date, Lipid_LDL) %>%
  datatable(rownames = FALSE, 
            options = list(scrollX = TRUE))

Comparing differences in values at current assessment to prior assessment

diff_data <- calc_diffs(noms_data)

if (file.exists(params$prior_assessments_path)) {
  diff_data <- diff_data %>%
    anti_join(prior_assessments, by = c("ConsumerID", "Assessment", "der_intake_seq_no"))
}

diff_data <- diff_data %>%
  filter(Assessment != 699)

The following plots show the difference between new values of certain variables and the values of those variables at the prior assessment, compared to a simualated reference distribution.

Weight

compare_diff(diff_data, "Weight")

The following is a table of the current and prior values of Weight, as well as the difference, shown in the plot.

diff_data %>%
  select(ConsumerID, Assessment, der_date,
         der_weight, der_weight_previous, der_weight_diff) %>%
  datatable(rownames = FALSE, 
            colnames = c("ConsumerID", "Assessment", "Date",
                         "Weight", "Previous weight", "Weight difference"),
            options = list(scrollX = TRUE))

Height

compare_diff(diff_data, "Height")

The following is a table of the current and prior values of Height, as well as the difference, shown in the plot.

diff_data %>%
  select(ConsumerID, Assessment, der_date,
         der_height, der_height_previous, der_height_diff) %>%
  datatable(rownames = FALSE, 
            colnames = c("ConsumerID", "Assessment", "Date",
                         "Height", "Previous height", "Height difference"),
            options = list(scrollX = TRUE))

WaistCircum

compare_diff(diff_data, "WaistCircum")

The following is a table of the current and prior values of WaistCircum, as well as the difference, shown in the plot.

diff_data %>%
  select(ConsumerID, Assessment, der_date,
         der_waistcircum, der_waistcircum_previous, der_waistcircum_diff) %>%
  datatable(rownames = FALSE, 
            colnames = c("ConsumerID", "Assessment", "Date",
                         "WaistCircum", "Previous WaistCircum", "WaistCircum difference"),
            options = list(scrollX = TRUE))

BPressure_s

compare_diff(diff_data, "BPressure_s")

The following is a table of the current and prior values of BPressure_s, as well as the difference, shown in the plot.

diff_data %>%
  select(ConsumerID, Assessment, der_date,
         der_bpressure_s, der_bpressure_s_previous, der_bpressure_s_diff) %>%
  datatable(rownames = FALSE, 
            colnames = c("ConsumerID", "Assessment", "Date",
                         "BPressure_s", "Previous BPressure_s", "BPressure_s difference"),
            options = list(scrollX = TRUE))

BPressure_d

compare_diff(diff_data, "BPressure_d")

The following is a table of the current and prior values of BPressure_d, as well as the difference, shown in the plot.

diff_data %>%
  select(ConsumerID, Assessment, der_date,
         der_bpressure_d, der_bpressure_d_previous, der_bpressure_d_diff) %>%
  datatable(rownames = FALSE, 
            colnames = c("ConsumerID", "Assessment", "Date",
                         "BPressure_d", "Previous BPressure_d", "BPressure_d difference"),
            options = list(scrollX = TRUE))

Weight / waist circumference ratio

compare_diff(diff_data, "Weight_Waist")

The following is a table of the current and prior values of the weight/waist circumference ratio, as well as the difference, shown in the plot.

diff_data %>%
  select(ConsumerID, Assessment, der_date,
         der_weight_waist, der_weight_waist_previous, der_weight_waist_diff) %>%
  datatable(rownames = FALSE, 
            colnames = c("ConsumerID", "Assessment", "Date",
                         "Weight/Waist ratio", "Previous Weight/Waist ratio", 
                         "Weight/Waist ratio difference"),
            options = list(scrollX = TRUE)) %>%
  formatCurrency(c("der_weight_waist", "der_weight_waist_previous", "der_weight_waist_diff"), 
                 currency = "", digits = 3)

sarahvanhala/nomscheck documentation built on May 11, 2019, 5:15 p.m.