5 курс / ОЗИЗО Общественное здоровье и здравоохранение / Статистический_анализ_данных_в_медицинских_исследованиях_в_2_ч_Красько

LM.reduce<- lm(BCTX ~ Age.Group.BCTX+Expose+Sex, data=Markers.New) Anova(LM.reduce, test="F")

anova(LM.reduce, LM.prem, test="F")

LM.fit <- stepAIC(LM.reduce, ~ .^2 ,direction='both', k=2,trace =T ) anova(LM.reduce, LM.fit, test="F")

Anova(LM.fit, test="F")

# основные графики для исследования остатков рис. 16-12 oldpar <- par(oma=c(0,0,3,0), mfrow=c(1,2),family='mono') plot(LM.fit,sub.caption = "LM.fit", which=c(1,2))

par(oldpar)

#проверка остатков res.LM.fit <- residuals(LM.fit) sf.test(res.LM.fit) shapiro.test(res.LM.fit)

# Рис. 16-13 графики эффектов trellis.device(theme="col.whitebg",family='mono') plot(allEffects(LM.fit), ask=F)

##################################

#Шаг 6 окончательная модель

##################################

#Таблицы 16-13 и 16-14 summary(LM.fit) Anova(LM.fit, test="F")

#проверка линейных гипотез linearHypothesis(LM.fit, "Expose[T.expose] = 0")

linearHypothesis(LM.fit, "Expose[T.expose] + Age.Group.BCTX[T.15-18]:Expose[T.expose] = 0") linearHypothesis(LM.fit, "Expose[T.expose] + Age.Group.BCTX[T.18+]:Expose[T.expose] = 0")

##########################

# прогноз

##########################

NewData <- matrix(c( 'до 15','male','expose', 'до 15','male','control', 'до 15','female','expose', 'до 15','female','control', '15-18','male','expose', '15-18','male','control', '15-18','female','expose', '15-18','female','control', '18+','male','expose', '18+','male','control', '18+','female','expose', '18+','female','control' ), 12, 3, byrow=TRUE)

rownames(NewData) <- c('1', '2', '3', '4', '5', '6','7', '8', '9', '10', '11', '12') colnames(NewData) <- c('Age.Group.BCTX', 'Sex','Expose')

NewData <- as.data.frame(NewData)

predict.fit <- predict(LM.fit, newdata = NewData, se.fit = T)

261

NewData$Means <- predict.fit$fit

LowCI <- (predict.fit$fit-1.96*predict.fit$se.fit)

HighCI <- (predict.fit$fit+1.96*predict.fit$se.fit)

NewData$LowCI <-LowCI

NewData$HighCI <-HighCI

# Таблица 16-15 NewData

##################################################################################

# Остеокальцин

##################################################################################

########################################################################

#Шаг 1 предварительные исследования зависимой переменной

########################################################################

#выделение контрольной группы

control.Osteocalcin <- subset(Markers, subset=Group=="control", select=c(Osteocalcin))

#проверка на соответствие закону нормального распределения shapiro.test(control.Osteocalcin$Osteocalcin) sf.test(control.Osteocalcin$Osteocalcin)

#выделение группы c воздействием

treat.Osteocalcin <- subset(Markers, subset=Group!="control", select=c(Osteocalcin))

# проверка на соответствие закону нормального распределения shapiro.test(treat.Osteocalcin$Osteocalcin) sf.test(treat.Osteocalcin$Osteocalcin)

#подбор параметра трансформации powerTransform (control.Osteocalcin$Osteocalcin)

#создание преобразованной переменной

Markers$Ost.sqrt <- with(Markers, sqrt(Osteocalcin))

#проверка преобразованной переменной на соответствие закону нормального распределения control.Ost.sqrt <- subset(Markers, subset=Group=="control", select=c(Ost.sqrt))

shapiro.test(control.Ost.sqrt$Ost.sqrt) sf.test(control.Ost.sqrt$Ost.sqrt)

# График Рис. 16-14

scatterplot(Ost.sqrt~age.at.measure | Sex, reg.line=FALSE, smooth=TRUE, spread=F, boxplots='xy', cex.axis=0.8, span=0.5, jitter=list(x=1, y=1), by.groups=TRUE, data=Markers)

# График Рис. 16-15

scatterplot(Ost.sqrt~age.at.measure | Group, reg.line=FALSE, smooth=TRUE, spread=F, boxplots='xy', cex.axis=0.8, span=0.5, jitter=list(x=1, y=1), by.groups=TRUE, data=Markers)

scatterplot(Ost.sqrt~age.at.measure | Expose, reg.line=FALSE, smooth=TRUE, spread=F, boxplots='xy', cex.axis=0.8, span=0.5, jitter=list(x=1, y=1), by.groups=TRUE, data=Markers)

##################################

# Шаг 2 предварительная модель

##################################

262

LM.0 <- lm(Ost.sqrt ~ Age.Group+Group+Sex, data=Markers) Anova(LM.0, test="F")

summary(LM.0)

########################################################################

#Шаг 3 провека линейной гипотезы о равенстве коэффициентов регрессии

#снижение количества параметров модели, сравнение моделей

########################################################################

#проверка линейной гипотезы о различимом воздействии выскокодозного и низкодозного воздействия linearHypothesis(LM.0, "Group[T.HighDose] - Group[T.LowDose] = 0")

linearHypothesis(LM.0, "Age.Group[T.10-14] = 0")

LM.1 <- lm(Ost.sqrt ~ Age.Group+Expose+Sex, data=Markers) Anova(LM.1, test="F")

summary(LM.1) anova(LM.0, LM.1, test="F")

##################################################

# Шаг 4 провека наличия эффектов взаимодействия

##################################################

LM.interaction <- stepAIC(LM.1, ~ .^2 ,direction='both', k=2,trace =T )

#Таблица 16-16 Anova(LM.interaction, test="F")

#Таблица 16-17 summary(LM.interaction)

##############################################

#Шаг 5 исследование остатков и выбросов

##############################################

#основные графики для исследования остатков рис. 16-16 oldpar <- par(oma=c(0,0,3,0), mfrow=c(2,2),family='mono') plot(LM.interaction,sub.caption = "LM.interaction", which=c(1,2)) par(oldpar)

#проверка остатков

res.LM.interaction <- residuals(LM.interaction) sf.test(res.LM.interaction) shapiro.test(res.LM.interaction)

# График Рис. 16-17

influencePlot(LM.interaction, id.method="identify")

outlierTest(LM.interaction, cutoff=Inf)

# влияние наблюдений (дополнительно) inflm <- influence.measures(LM.interaction) summary(inflm)

LM.fit <- LM.interaction

# График Рис. 16-18 trellis.device(theme="col.whitebg", family='mono') plot(allEffects(LM.fit), ask=F)

##################################

263

#Шаг 6 окончательная модель

##################################

Anova(LM.fit, test="F") summary(LM.fit)

#проверка линейных гипотез linearHypothesis(LM.fit, "Expose[T.expose] = 0")

linearHypothesis(LM.fit, "Expose[T.expose] + Age.Group[T.10-14]:Expose[T.expose] = 0") linearHypothesis(LM.fit, "Expose[T.expose] + Age.Group[T.15-18]:Expose[T.expose] = 0") linearHypothesis(LM.fit, "Expose[T.expose] + Age.Group[T.18+]:Expose[T.expose] = 0")

##################################

# прогноз

##################################

NewData <- matrix(c( 'до 10','male','expose', 'до 10','male','control', 'до 10','female','expose', 'до 10','female','control', '10-14','male','expose', '10-14','male','control', '10-14','female','expose', '10-14','female','control', '15-18','male','expose', '15-18','male','control', '15-18','female','expose', '15-18','female','control', '18+','male','expose', '18+','male','control', '18+','female','expose', '18+','female','control' ), 12, 3, byrow=TRUE)

colnames(NewData) <- c('Age.Group', 'Sex','Expose') NewData <- as.data.frame(NewData)

predict.fit <- predict(LM.fit, newdata = NewData, se.fit = T)

NewData$Means <- (predict.fit$fit)^2

LowCI <- (predict.fit$fit-1.96*predict.fit$se.fit)

HighCI <- (predict.fit$fit+1.96*predict.fit$se.fit)

NewData$LowCI <-LowCI^2

NewData$HighCI <-HighCI^2

# Таблица 16-18 NewData

264

Приложение R-11

library(Rcmdr)

library(effects)

#################################################

# формирование набора данных на основе таблицы 17-6

TC <- matrix(rep(c('Advance','C1',1), 11), nrow=11, byrow=TRUE)

TC <- rbind (TC, matrix(rep(c('Advance','C1',0), 6), nrow=6, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C1',1), 43), nrow=43, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C1',0), 29), nrow=29, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Advance','C2',1), 32), nrow=32, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Advance','C2',0), 17), nrow=17, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C2',1), 35), nrow=35, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C2',0), 26), nrow=26, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Advance','C3',1), 38), nrow=38, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Advance','C3',0), 7), nrow=7, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C3',1), 15), nrow=15, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C3',0), 20), nrow=20, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Advance','C4',1), 47), nrow=47, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Advance','C4',0), 10), nrow=10, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C4',1), 22), nrow=22, byrow=TRUE))

TC <- rbind (TC, matrix(rep(c('Basic','C4',0), 13), nrow=13, byrow=TRUE))

TC$Response <- with(TC, 1*(Response=='1'))

#####################################################

#выбираем базовое лечение как референтную группу

#выбираем первый центр как референтную группу

#####################################################

TC$Treatment <- factor(TC$Treatment, levels=c('Basic','Advance')) TC$Center <- factor(TC$Center, levels=c('C1','C2','C3','C4'))

xtabs(~Response+Treatment+Center, data=TC)

#####################################################

# логит-модель со взаимодействием

#####################################################

LogitModel.1 <- glm(Response ~ Treatment*Center, family=binomial(logit), data=TC) Anova(LogitModel.1, test="LR")

summary(LogitModel.1)

############################################

# результаты ОДЛ по центрам различаются?

############################################

linearHypothesis(LogitModel.1, "Treatment[T.Advance]:Center[T.C3] = Treatment[T.Advance]:Center[T.C4]") linearHypothesis(LogitModel.1, "Treatment[T.Advance]:Center[T.C2] = Treatment[T.Advance]:Center[T.C4]") linearHypothesis(LogitModel.1, "Treatment[T.Advance]:Center[T.C2] = Treatment[T.Advance]:Center[T.C3]")

265

############################################

# результаты ОЛ по центрам различаются?

############################################

linearHypothesis(LogitModel.1, "Center[T.C3] = Center[T.C4]") linearHypothesis(LogitModel.1, "Center[T.C2] = Center[T.C4]") linearHypothesis(LogitModel.1, "Center[T.C2] = Center[T.C3]")

#####################################################

# добавляем 10 одинаковых записей

#####################################################

newData <- matrix(rep(c('Advance','C1',1), 10), nrow=10, byrow=TRUE) colnames(newData) <- colnames(TC)

TC<- rbind(TC, newData)

TC$Response <- as.numeric(TC$Response)

TC$Treatment <- factor(TC$Treatment, levels=c('Basic','Advance')) TC$Center <- factor(TC$Center, levels=c('C1','C2','C3','C4'))

xtabs(~Response+Treatment+Center, data=TC)

#####################################################

# логит-модель со взаимодействием на новых данных

LogitModel.2 <- glm(Response ~ Treatment*Center, family=binomial(logit), data=TC)

Anova(LogitModel.2, test="LR")

linearHypothesis(LogitModel.2, "Treatment[T.Advance]:Center[T.C3] = Treatment[T.Advance]:Center[T.C4]") linearHypothesis(LogitModel.2, "Treatment[T.Advance]:Center[T.C2] = Treatment[T.Advance]:Center[T.C4]") linearHypothesis(LogitModel.2, "Treatment[T.Advance]:Center[T.C2] = Treatment[T.Advance]:Center[T.C3]")

linearHypothesis(LogitModel.2, "Center[T.C3] = Center[T.C4]") linearHypothesis(LogitModel.2, "Center[T.C2] = Center[T.C4]") linearHypothesis(LogitModel.2, "Center[T.C2] = Center[T.C3]")

#####################################################

# логит-модель без взаимодействия на новых данных

LogitModel.3 <- glm(Response ~ Treatment+Center, family=binomial(logit), data=TC) Anova(LogitModel.3, test="LR")

summary(LogitModel.3)

Confint(LogitModel.3, level=0.95, type="LR")

##########################################

# графики эффектов для сравнения

trellis.device(theme="col.whitebg", family="mono") plot(allEffects(LogitModel.1),sub="LogitModel.1", ask=FALSE) trellis.device(theme="col.whitebg", family="mono") plot(allEffects(LogitModel.2),sub="LogitModel.2", ask=FALSE) trellis.device(theme="col.whitebg", family="mono") plot(allEffects(LogitModel.3),sub="LogitModel.3", ask=FALSE)

###############################################################

# Расчет теста гомогенности и отношения шансов по Мантелю-Хензелю (пакет epiR) library(epiR)

epi.mh(ev.trt = c( 11,32,38,47), n.trt = c(17,49,45,57), ev.ctrl = c(43,35,15,22), n.ctrl = c(72,61,35,35),

266

names =c('C1','C2','C3','C4'), method = "odds.ratio", alternative = "two.sided", conf.level = 0.95)

epi.mh(ev.trt = c( 21,32,38,47), n.trt = c(27,49,45,57), ev.ctrl = c(43,35,15,22), n.ctrl = c(72,61,35,35), names =c('C1','C2','C3','C4'), method = "odds.ratio", alternative = "two.sided", conf.level = 0.95)

###############################################################

# расчет теста гомогенности и отношения шансов по Мантелю-Хензелю и визуализация с помощью пакета rmeta

library(rmeta)

a <- meta.MH(ntrt = c(17,49,45,57), nctrl = c(72,61,35,35),

ptrt = c( 11,32,38,47), pctrl = c(43,35,15,22),names =c('C1','C2','C3','C4') ) metaplot(a$logOR, a$selogOR, nn=a$selogOR^-2, a$names, summn=a$logMH, sumse=a$selogMH, sumnn=a$selogMH^-2,logeffect=TRUE)

b <-meta.MH(ptrt = c( 21,32,38,47),ntrt = c(27,49,45,57), pctrl = c(43,35,15,22), nctrl = c(72,61,35,35), names =c('C1','C2','C3','C4'), conf.level=0.95,statistic="OR") metaplot(b$logOR, b$selogOR, nn=b$selogOR^-2, b$names, summn=b$logMH, sumse=b$selogMH, sumnn=b$selogMH^-2,logeffect=TRUE)

267

DD$timepoint <- factor(DD$timepoint)

DD$timepoint <- factor(DD$timepoint, levels=c('before','after'))

############### Шаг 1 – проверка предположений

with(DD, tapply(BioChem, as.factor(paste(treatment,timepoint)), shapiro.test)) leveneTest(BioChem ~ treatment*timepoint, data=DD, center=mean)

###### Шаг 2 – Выполнение анализа

#библиотека ez model.RManova = ezANOVA( data = DD

, dv = BioChem , wid = Number

, within = timepoint

, between = treatment) print(model.RManova)

#библиотека lme4

#################### Модель смешанных эффектов

model <- lmer( BioChem ~ treatment*timepoint +(1|Number), data=DD) anova(model)

###### Шаг 3 Проверка остатков модели qqPlot(resid(model), dist="norm", id.method="y" )

###### Шаг 4 Расчет эффектов и визуализация lsmeans(model)

difflsmeans(model)

trellis.device(theme="col.whitebg", family="mono") opar <- par(mfrow = c(1,1), oma = c(1.1, 0, 1.1, 0), las = 1)

with(DD, boxplot(BioChem ~ timepoint+ treatment, outline=T, notch=F,cex.axis=0.7)) title(main="RM-Anova")

title(ylab="BioChem")

trellis.device(theme="col.whitebg", family="mono") opar <- par(mfrow = c(1,1), oma = c(1.1, 0, 1.1, 0), las = 1)

ezPlot( data = DD

,dv = BioChem

,wid = Number

,within = timepoint

,between = treatment ,x=timepoint ,do_lines=T ,split=treatment

,y_lab="средние BioChem"

)+ theme_bw(base_size = 12, base_family = "mono")

269

Приложение R-13

270