прогнозирования от flexmix объекта (R)

Question

я вписываюсь некоторые данные распределения смеси двух гауссовских в flexmix:

data("NPreg", package = "flexmix") 
mod <- flexmix(yn ~ x, data = NPreg, k = 2, 
      model = list(FLXMRglm(yn ~ x, family= "gaussian"), 
         FLXMRglm(yn ~ x, family = "gaussian"))) 

модель прилегание следующим образом:

> mod 

Call: 
flexmix(formula = yn ~ x, data = NPreg, k = 2, model = list(FLXMRglm(yn ~ x, family = "gaussian"), 
    FLXMRglm(yn ~ x, family = "gaussian"))) 

Cluster sizes: 
    1 2 
74 126 

convergence after 31 iterations 

Но как я на самом деле предсказать из этой модели?

когда я

pred <- predict(mod, NPreg) 

получить список с предсказаниями от каждого из двух компонентов

Чтобы получить один прогноз, я должен добавить в размере кластера, как это?

single <- (74/200)* pred$Comp.1[,1] + (126/200)*pred$Comp.2[,2] 

Answer 1

Я использую flexmix для предсказания следующим образом:

pred = predict(mod, NPreg) 
clust = clusters(mod,NPreg) 
result = cbind(NPreg,data.frame(pred),data.frame(clust)) 
plot(result$yn,col = c("red","blue")[result$clust],pch = 16,ylab = "yn") 

И матрицы неточностей:

table(result$class,result$clust) 

Для получения прогнозируемых значений yn, я выбираю значение компонента кластера, которому принадлежит точка данных.

for(i in 1:nrow(result)){ 
    result$pred_model1[i] = result[,paste0("Comp.",result$clust[i],".1")][i] 
    result$pred_model2[i] = result[,paste0("Comp.",result$clust[i],".2")][i] 
} 

Действительный против прогнозируемых результатов показывают подгонку (добавление только один из них здесь, как и в вашей модели такие же, вы бы использовать pred_model2 для второй модели).

qplot(result$yn, result$pred_model1,xlab="Actual",ylab="Predicted") + geom_abline() 

RMSE = sqrt(mean((result$yn-result$pred_model1)^2)) 

дает корень среднеквадратичной ошибки в 5.54.

Этот ответ основан на многих ответах SO, которые я прочитал, работая с flexmix. Это сработало для моей проблемы.

Вы также можете быть заинтересованы в визуализации двух распределений. Моя модель была следующей, которая показывает некоторое перекрытие, поскольку отношение компонентов не близко к 1.

Call: 
flexmix(formula = yn ~ x, data = NPreg, k = 2, 
model = list(FLXMRglm(yn ~ x, family = "gaussian"), 
      FLXMRglm(yn ~ x, family = "gaussian"))) 

     prior size post>0 ratio 
Comp.1 0.481 102 129 0.791 
Comp.2 0.519 98 171 0.573 

'log Lik.' -1312.127 (df=13) 
AIC: 2650.255 BIC: 2693.133 

Я также создаю распределение плотности с гистограммами для визуализации обоих компонентов. Это было вызвано SO answer от сопровождающего betareg.

a = subset(result, clust == 1) 
b = subset(result, clust == 2) 
hist(a$yn, col = hcl(0, 50, 80), main = "",xlab = "", freq = FALSE, ylim = c(0,0.06)) 
hist(b$yn, col = hcl(240, 50, 80), add = TRUE,main = "", xlab = "", freq = FALSE, ylim = c(0,0.06)) 
ys = seq(0, 50, by = 0.1) 
lines(ys, dnorm(ys, mean = mean(a$yn), sd = sd(a$yn)), col = hcl(0, 80, 50), lwd = 2) 
lines(ys, dnorm(ys, mean = mean(b$yn), sd = sd(b$yn)), col = hcl(240, 80, 50), lwd = 2) 

# Joint Histogram 
p <- prior(mod) 
hist(result$yn, freq = FALSE,main = "", xlab = "",ylim = c(0,0.06)) 
lines(ys, p[1] * dnorm(ys, mean = mean(a$yn), sd = sd(a$yn)) + 
     p[2] * dnorm(ys, mean = mean(b$yn), sd = sd(b$yn))) 

Answer 2

Вы можете передать дополнительный аргумент для вашего вызова прогнозирования.

pred <- predict(mod, NPreg, aggregate = TRUE)[[1]][,1]