Байесовские сети: ситуация с разной точностью

Question

У меня проблема с байесовскими сетями, и я надеюсь найти ответ. Я попытаюсь разделить мой вопрос, чтобы улучшить ваше понимание!

ЦЕЛЬ: После обучения моей модели, учитывая переменные X (читай матрицу A), я хочу предсказать переменные Y (читай матрицу B). Как пример:

Учитывая доказательства в переменных A,B,C, я хочу предсказать переменные D,E,F

По этому вы можете видеть, что я ищу многовариантное предсказание!

ПРОБЛЕМА ИЛИ КАТАСТРОФА: В настоящее время я использую пакет bnlearn в R, и проблема в том, что: худшие модели (пустой и случайный граф) иногда имеют лучшую точность, чем моя лучшая модель (полученная из данных), или выглядят очень близко к моя лучшая модель! и что еще хуже, тестовый набор находится внутри моего тренировочного набора, так что технически моя лучшая модель должна выполнить ~100%, а этого не происходит!

Я хочу знать, есть ли какая-либо математическая ошибка в моей реализации (я объяснил шаг за шагом в коде) и как я могу объяснить эту ситуацию...

PS1: я знаю, что необходимо разделить данные, но в моем реальном проекте мне не хватает строк, и изменение набора данных (размера), вероятно, изменит окончательную модель

PS2: мультиваревая точность отсутствует в пакете, поэтому была создана вручную

Вот мой код с комментариями:

library(bnlearn)
# Dataframe
al <- alarm

# Nodes that I'm going to use as evidence to my models
nodeEvid <- names(al)[-c(30,31,32,33,34,35,36,37)]

# Nodes that I'm going to use as events to my models
nodeEvnt <- names(al)[c(30,31,32,33,34,35,36,37)]

## Best Model - Using all my data to create the arcs
bn_k2 <- tabu(x = al, score = 'k2')

## Worst Models
# Empty model
bn_eg <- empty.graph(names(al))

# Random model
bn_rd <- random.graph(names(al))

# Fitting the models ...
modelsBN = list(bn.fit(x = bn_k2, data = al), 
bn.fit(x = bn_eg, data = al),
bn.fit(x = bn_rd, data = al))

# Seed
set.seed(7)

# Selecting randomly lines to create our dTest
trainRows <- sample(1:nrow(al),as.integer(nrow(al)*0.30) , replace=F)

# Dataframe for test
dTest <- al[trainRows,]
# ACCURACY - CPDIST TO MULTI-VAR

# Dataframe to keep all the results in the end
accuracyCPD <- setNames(data.frame(matrix(ncol = length(nodeEvnt) + 1, nrow =     length(modelsBN))), c(nodeEvnt,"TOTAL MEAN ACCURACY BY MODEL"))

# Process to calculate ...
for (m in 1:length(modelsBN)){ # For every m bayesian model that I created
  # predCPD is a dataframe generated to keep the results to each sample run, I will explain more ahead...
  predCPD <- setNames(data.frame(matrix(ncol = length(nodeEvnt), nrow = nrow(dTest))), nodeEvnt)

  for (i in seq(nrow(dTest))){ # For i samples in my dTest
    #cpdist is a function that returns a dataframe of predictions based on conditional probability distribution from the model, with the rows being n value and the columns being
    # the nodeEvnt. So I will save his results in a dataframe called 'teste'
    teste <- cpdist(modelsBN[[m]], nodes = nodeEvnt, evidence = as.list(dTest[i, names(dTest) %in% nodeEvid]), n = 1000, method = "lw")
    # Here I use predCPD to calculate a % of how many times was returned the TRUE value/rows from my teste dataframe (tries from my model), this will be done to each variable 
    # from nodeEvnt
    for (j in 1:length(nodeEvnt)){ # Gerar media de acertos para j fatores bioticos
      predCPD[i,nodeEvnt[j]] <- sum(teste[nodeEvnt[j]] == as.character(dTest[i,nodeEvnt[j]]), na.rm = TRUE)/nrow(teste)
    }
  }

  # Here I do a 'Mean from means' (because predCPD is technically a mean) after my dTest is done, so accCPD have the results to that m model
  accCPD <- colMeans(predCPD, na.rm = TRUE)
  # Here I just multiply by 100 to put in the format 0 - 100 %
  for (j in 1:length(nodeEvnt)){
    accuracyCPD[m,nodeEvnt[j]] <- accCPD[nodeEvnt[j]]*100
  }
  # Here I do a mean from my target variables to save in "TOTAL MEAN ACCURACY BY MODEL"
  accuracyCPD[m,length(nodeEvnt) + 1] <- mean(accCPD)*100
}

Я действительно хочу разрешить эту ситуацию, и я думаю, что ответ будет в КПП, но это всего лишь попытка...