мультиномиальная логистика c регрессия в R: nnet / multinom и набор независимых двоичных регрессий дают разные вероятности

Question

Я сравнил результаты полиномиальной логистической c регрессии с использованием пакета nnet / multinom и набора независимых двоичных регрессий. Прогнозы этих моделей разные. Является ли моя реализация набора бинарных регрессий неправильной или разница ожидается из-за того, что метод реализован по-другому?

В качестве воспроизводимого примера я использую данные и модель из «Мультиномиальной логистики c регрессии | Примеры анализа данных R »из https://stats.idre.ucla.edu/r/dae/multinomial-logistic-regression/

Тестовые данные

prog - это результат c=("academic", "general", "vocation"), а в примере это прогноз ses и write

Модель nnet

require(nnet)
require(foreign)
require(tidyverse)
ml <- read.dta("https://stats.idre.ucla.edu/stat/data/hsbdemo.dta") %>%
  select(prog, ses, write)
ml$prog2 <- relevel(ml$prog, ref = "academic")
nnet_test <- multinom(prog2 ~ ses + write, data = ml)
nnet_predictions <- bind_cols(ml, as.data.frame(fitted(nnet_test))) %>%
  select(-prog2) %>%
  unique()

Модель набора биномов

Поскольку есть 3 возможных выхода, я использую 2 биномиальные модели: 1-я «academi c» против двух других 2-го «общего» против «призвания» при условии, что это полный набор данных.

1-й бином

ml_b1 <- ml %>%
  mutate(prog3 = case_when(prog2 == "academic" ~ "academic",
                           TRUE ~ "other1")) %>%
  mutate(prog3 = as.factor(prog3))

ml_b1$prog3a <- relevel(ml_b1$prog3, ref = "academic")

b1_test <- glm(prog3a ~ write, 
               family=binomial,
               data = ml_b1)
fitted <- as.data.frame(fitted(b1_test))
names(fitted) <- "p_other"
ml_b1 <- bind_cols(ml_b1, fitted) %>%
  mutate(p_academic = 1- p_other) %>%
  unique() 

2-й бином

ml_b2 <- ml %>%
  mutate(prog3 = case_when(prog2 == "general" ~ "general",
                           prog2 == "vocation" ~ "vocation",
                           TRUE ~ NA_character_)) %>%
  mutate(prog3 = as.factor(prog3))
ml_b2$prog3a <- relevel(ml_b2$prog3, ref = "general")
ml_b2<- ml_b2%>%
  select(-prog3) %>%
  drop_na(prog3a)
b2_test <- glm(prog3a ~ write, 
               family=binomial,
               data = ml_b2)
pred <- as.data.frame(predict(b2_test, newdata = ml_b1, type = "response"))
names(pred) <- "p_vocation"

stacked_predictions <- ml_b1 %>%
  select(-prog3a) %>%
  bind_cols(pred) %>%
  mutate(p_vocation = p_vocation * p_other,
         p_general = 1 - p_vocation - p_academic) %>%
  select(-p_other, -prog2, -prog3) %>%
  unique() 

Все предсказанные вероятности различны:

head(nnet_predictions)
#  prog     ses   write  academic   general   vocation
#1 vocation low    35    0.1482764  0.3382454 0.5134781
head(stacked_predictions) 
#  prog     ses   write p_academic p_vocation p_general
#1 vocation low    35   0.1768801  0.5754063  0.2477136

Если я определю предсказанный результат как результат с максимальной предсказанной вероятностью, предсказания двух методов будут одинаковыми для ~ 87% случаев.

«Точность» двух моделей, определяемая вероятностью предсказанного результата, такая же, как и наблюдаемый результат - это же 0,4622642 для двух моделей.

Любое понимание это было бы очень признательно.