График зависимости минеральной плотности костной ткани (BMD) с интервалом t-показателя (2,5 SD)?

Question

Извините, если этот вопрос плохо задан, первый в истории вопрос.

Цель: рассчитать Т-критерий минеральной плотности кости (+/- 2,5 SD для значения BMD, зависящего от пола и возраста).Чтобы сказать, является ли пациент остеопорозом или нет.

Я пытаюсь сделать это графически, используя ggplot 2 и geom_smooth

Я использую набор данных NHANES (https://wwwn.cdc.gov/Nchs/Nhanes/2013-2014/DXXFEM_H.htm#DXXINBMD), к которому обращаютсячерез пакет nhanesA.

r загружать программы:

library(nhanesA)
library(ggplot2)

Меня интересует только межпочвенная МПК, возраст и пол.

r загрузить данные:

nhanesTableVars('EXAM', "DXXFEM_D")
DXXFEM_D  <- nhanes('DXXFEM_D')
fem_d <- DXXFEM_D
demo_d <- nhanes('DEMO_D')
demo_d <- nhanesTranslate('DEMO_D', 'RIAGENDR', data=demo_d)
DXXFEM_D_vars  <- nhanesTableVars('EXAM', 'DXXFEM_D', namesonly=TRUE)
DXXFEM_D <- nhanesTranslate('DXXFEM_D', DXXFEM_D_vars, data=DXXFEM_D)
FEM_demo <- merge(demo_d, DXXFEM_D)
FEM_demo_1 <- FEM_demo[,c(5,6,55)]

Затем я попытался построить график, но с аргументом уровней в "geom_smooth" не работает с уровнем на уровне 2.5.

rграфик BMD с SD:

ggplot(data = FEM_demo_1, aes(x = RIDAGEYR, y = DXXINBMD, group = RIAGENDR, color = RIAGENDR)) + 
  geom_smooth(se = TRUE, level = 2.5) + 
  scale_x_continuous(minor_breaks = seq(0,85,1), breaks = seq(0,85,5))

1) В идеале мне бы понравился график, который показывает среднее значение, -1SD (что относится к остеопении) и -2SD, которое относится к отсечению остеопороза, который можетиспользоваться для перевода МПК в клинические критерии.Есть ли способ сделать это?

2) Есть ли способ сделать это численно?

Спасибо

Answer 1

Вот код для графика со средним значением -1SD и -2SD.Вы можете добавить стиль по своему вкусу.Расчеты для среднего и SD выполняются заранее в кадре данных.

data <- aggregate(FEM_demo_1$DXXINBMD, by=list(FEM_demo_1$RIAGENDR, FEM_demo_1$RIDAGEYR), FUN=mean, na.rm=TRUE)
names(data) <- c("gender", "age", "mean")
data[,"sd"] <- aggregate(FEM_demo_1$DXXINBMD, by=list(FEM_demo_1$RIAGENDR, FEM_demo_1$RIDAGEYR), FUN=sd, na.rm=TRUE)[3]

ggplot(data=data, aes(x=age, group=gender))+
  geom_smooth(se = FALSE, aes(y=mean))+
  geom_smooth(se = FALSE, aes(y=mean-sd))+
  geom_smooth(se = FALSE, aes(y=mean-(2*sd)))