Сравнение результатов (доверительных интервалов) одной модели применительно к разным выборкам данных - PullRequest
0 голосов
/ 05 сентября 2018

Ребята, я собрал данные для полного факторного дизайна. Чтобы выяснить, какие дробные схемы лучше всего подходят для моей модели / задачи, я хочу сравнить результаты одной и той же модели, примененной к различным подмножествам (например, federov, optBlock, Monte Carlo), с полными данными. Я надеюсь сократить количество времени в будущем, выбрав лучший дробный дизайн в отношении моего проблемного случая. Коллега предлагает построить доверительные интервалы и, если их совпадение, результаты моделей должны быть одинаковыми. Я подумал, что сравнение теста Тьюки также может быть разумным. Поэтому я хочу объединить оба «% 95 семейных» уровня достоверности, которые я уже достиг, в один отдельный график и использовать разные цвета для обоих типов. Это то, что нужно сделать, чтобы достичь моей цели? Как я могу достичь этой цели относительно синтаксиса R. Я добавил соответствующий пример кода.

 library(data.table)
federovData <- fread('http://studierfurt.de//data/Federov_Gleichverteilung.csv')
fullData <- fread("http://studierfurt.de/data/ParaTuning_2018.08.13.csv")

# convert categorial variables to factors
fullData$Velotype = factor(fullData$Velotype)
fullData$block = factor(fullData$block)
federovData$Velotype = factor(federovData$Velotype)
federovData$block = factor(federovData$block)

#y-data transformation
fullData$`Relative gap` = log(fullData$`Relative gap`+0.1)
federovData$`Relative gap` = log(federovData$`Relative.gap`+0.1)

fullModel = lm(`Relative gap`~block+SwapRemoveProb*AssignmentMutationProb*Velotype
               +I(SwapRemoveProb^2)+I(AssignmentMutationProb^2)
               ,data=fullData)
federovModel = lm(`Relative gap`~block+SwapRemoveProb*AssignmentMutationProb*Velotype
                  +I(SwapRemoveProb^2)+I(AssignmentMutationProb^2)
                  ,data=federovData)

federovAn <- aov(`Relative gap`~block+SwapRemoveProb*AssignmentMutationProb*Velotype+I(SwapRemoveProb^2)+I(AssignmentMutationProb^2),federovData)
fullAn <- aov(`Relative gap`~block+SwapRemoveProb*AssignmentMutationProb*Velotype+I(SwapRemoveProb^2)+I(AssignmentMutationProb^2),fullData)
summary(federovAn)
summary(fullAn)
# apply tukey test
federovPostHoc <- TukeyHSD(x=federovAn,which="Velotype",FALSE,conf.level=0.95)
fullPostHoc <- TukeyHSD(x=fullAn,which="Velotype",FALSE,conf.level=0.95)
par(mfrow=c(1,2))
plot(federovPostHoc)
plot(fullPostHoc)
# plot
par(mfrow=c(2,3))
plot(`Relative gap`~block+SwapRemoveProb*AssignmentMutationProb*Velotype
     +I(SwapRemoveProb^2)+I(AssignmentMutationProb^2), data = federovData, type = 'p',ylab="Relative gap")
# plot
par(mfrow=c(2,3))
plot(`Relative gap`~block+SwapRemoveProb*AssignmentMutationProb*Velotype
     +I(SwapRemoveProb^2)+I(AssignmentMutationProb^2), data = fullData, type = 'p',ylab="Relative gap")

enter image description here

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...