r - R 中朴素贝叶斯数值预测器的奇怪结果

Question

更新:

下面的代码应该是可重现的

someFrameA = data.frame(label="A", amount=rnorm(10000, 100, 20))
someFrameB = data.frame(label="B", amount=rnorm(1000, 50000, 20))
wholeFrame = rbind(someFrameA, someFrameB)
fit <- e1071::naiveBayes(label ~ amount, wholeFrame)
wholeFrame$predicted = predict(fit, wholeFrame)
nrow(subset(wholeFrame, predicted != label))

就我而言，这导致了 243 个错误分类。

注意这两行:(行号、标签、金额、预测)

10252     B 50024.81895         A
2955      A   100.55977         A
10678     B 50010.26213         B

虽然输入仅相差 12.6，但分类会发生变化。奇怪的是，像这样的行的后验概率如此接近:

> predict(fit, wholeFrame[10683, ], type="raw")
             A         B
[1,] 0.5332296 0.4667704

原始问题:

我正在尝试使用交易金额对一些银行交易进行分类。我的原始模型中有许多其他基于文本的特征，但在仅使用数字特征时注意到一些可疑的地方。

> head(trainingSet)
                 category amount
1                   check 688.00
2 non-businesstransaction   2.50
3 non-businesstransaction  36.00
4 non-businesstransaction 243.22
5                 payroll 302.22
6 non-businesstransaction  16.18

fit <- e1071::naiveBayes(category ~ amount, data=trainingSet)
fit

离散预测器的朴素贝叶斯分类器

调用:naiveBayes.default(x = X, y = Y, 拉普拉斯 = 拉普拉斯)

A-priori probabilities:
Y
                bankfee                   check       creditcardpayment       e-commercedeposit               insurance 
            0.029798103             0.189613233             0.054001459             0.018973486             0.008270494 
      intrabanktransfer             loanpayment              mcapayment non-businesstransaction                     nsf 
            0.045001216             0.015689613             0.011432741             0.563853077             0.023351982 
                  other                 payroll              taxpayment          utilitypayment 
            0.003405497             0.014838239             0.005716371             0.016054488 

Conditional probabilities:
                         amount
Y                               [,1]        [,2]
  bankfee                  103.58490   533.67098
  check                    803.44668  2172.12515
  creditcardpayment        819.27502  2683.43571
  e-commercedeposit         42.15026    59.24806
  insurance                302.16500   727.52321
  intrabanktransfer       1795.54065 11080.73658
  loanpayment              308.43233   387.71165
  mcapayment               356.62755   508.02412
  non-businesstransaction  162.41626   951.65934
  nsf                       44.92198    78.70680
  other                   9374.81071 18074.36629
  payroll                 1192.79639  2155.32633
  taxpayment              1170.74340  1164.08019
  utilitypayment           362.13409  1064.16875

根据 e1071 文档，“条件概率”的第一列是数值变量的平均值，另一列是标准差。这些均值和标准差以及先验概率都是正确的。

所以，这一行令人不安:

> thatRow
   category   amount
40    other 11268.53

接收这些后验:

> predict(fit, newdata=thatRow, type="raw")
          bankfee       check creditcardpayment e-commercedeposit    insurance intrabanktransfer   loanpayment    mcapayment
[1,] 4.634535e-96 7.28883e-06      9.401975e-05         0.4358822 4.778703e-51        0.02582751 1.103762e-174 1.358662e-101
     non-businesstransaction       nsf       other      payroll   taxpayment utilitypayment
[1,]            1.446923e-29 0.5364704 0.001717378 1.133719e-06 2.059156e-18   2.149142e-24

请注意，“nsf”的分数大约是“other”的 300 倍。由于这笔交易的金额为 11,200 美元，如果遵循“nsf”分布，则与平均值的标准差将超过 100 个。同时，由于“其他”交易的样本均值约为 9k 美元，并且标准差较大，因此我认为该交易作为“其他”交易的可能性更大。虽然“nsf”更有可能是先验概率，但它们并没有那么不同，以至于超过了尾部观察，并且除了“其他”之外，还有很多其他可行的候选者。

我假设这个包只是查看正常的(mew=samplemean, stdev=samplestdev) pdf并使用该值进行相乘，但事实并非如此吗？我不太清楚如何查看源代码。

数据类型似乎也很好:

> class(trainingSet$amount)
[1] "numeric"
> class(trainingSet$category)
[1] "factor"

打印输出中的“离散预测器的朴素贝叶斯分类器”可能很奇怪，因为这是一个连续预测器，但我认为这个包可以处理连续预测器。

我使用 klaR 包得到了类似的结果。也许我需要设置内核选项？

Answer 1

阈值参数是其中很大一部分。包中的代码有点像这样:

 L <- sapply(1:nrow(newdata), function(i) {
        ndata <- newdata[i, ]
        L <- log(object$apriori) + apply(log(sapply(seq_along(attribs),
            function(v) {
                nd <- ndata[attribs[v]]
                if (is.na(nd)) rep(1, length(object$apriori)) else {
                  prob <- if (isnumeric[attribs[v]]) {
                    msd <- object$tables[[v]]
                    msd[, 2][msd[, 2] <= eps] <- threshold
                    dnorm(nd, msd[, 1], msd[, 2])
                  } else object$tables[[v]][, nd]
                  prob[prob <= eps] <- threshold
                  prob
                }

阈值(并且已记录)将替换任何小于 eps 的概率。因此，如果连续变量的正常 pdf 为 0.000000000，则默认情况下它将变为 .001。

> wholeFrame$predicted = predict(fit, wholeFrame, threshold=0.001)
> nrow(subset(wholeFrame, predicted != label))
[1] 249
> wholeFrame$predicted = predict(fit, wholeFrame, threshold=0.0001)
> nrow(subset(wholeFrame, predicted != label))
[1] 17
> wholeFrame$predicted = predict(fit, wholeFrame, threshold=0.00001)
> nrow(subset(wholeFrame, predicted != label))
[1] 3

现在，我相信 sapply 返回的数量不正确，因为在“调试”它时，我得到了类似于 .012 的内容，本应是 dnorm (49990, 100, 20)，我认为有些东西被遗漏/与平均值和标准差矩阵混合，但无论如何，设置阈值将对此有所帮助。

.001*(10/11) > pdfB*(1/11) 或由于这种情况 A 的后验比 B 更高，意味着 pdfB 必须偶然小于 .01。

> dnorm(49977, 50000, 20)
[1] 0.01029681
> 2*pnorm(49977, 50000, 20)
[1] 0.2501439

由于 B 类中有 1000 个观察值，因此我们预计会有大约 250 个错误分类，这与原始的 243 个非常接近。