R One-Class SVM - Get Probabilistic outputs

Question

I am trying to find away to derive probabilistic outputs when predicting from a one-class svm in R. I know this is not supported in libsvm and I also know this question has been asked before and here a couple of years ago on SO but packages were not available at that time. I'm hoping things have changed now! Also this question is still valid as no approach implemented in R was given as a solution.

I could not find a package to do this so I tried two approaches myself to get around this:

1. Get the decision values and transform them through the use of the sigmoid activation function. This is described in this paper. Note the paragraph:

Furthermore, SVMs can also produce class probabilities as output instead of class labels. This is can done by an improved implementation (Lin, Lin, and Weng 2001) of Platt’s a posteriori probabilities (Platt 2000) where a sigmoid function is fitted to the decision values f of the binary SVM classifiers, A and B being estimated by minimizing the negative log-likelihood function

2. Use a logistic regression function on the predicted output and derive the probabilities from it. This approach was first described by Platt and an approach is outlined here

My problem is that to check if either of my two solutions are plausible, I tested these two approaches on a two-class svm problem as e1071, using libsvm, gives probabilities for two-class problems so this was taken as the 'truth'. I found that neither of my approaches aligned closely to libsvm.

Here are three graphs showing the resulting probabilities versus the known decision values. Click to see image. Sorry I seem to have too low a reputation to embed the image which is frustrating! I'm not sure if someone in the community with a higher reputation can edit to embed?

I think my Platt approach is theoretically more sound but, as can be seen from the graph, it appears the logistic regression was somehow too good, the probabilities associated with either classification being extremely close to 1 for positive and 0 for negative.

My code for the Platt implementation is

platt_scale <- function(oc_svm, X){
  # Get SVM predictions
  y_pred <- predict(oc_svm$best.model,X)
  #y_pred <- as.factor(ifelse(y_pred==T,"pos","neg"))
  # Train using logistic regression with cross-validation 
  require(caret)
  model <- train(x = X,
                 y = y_pred,
                 method = "glm",
                 family=binomial(),
                 trControl = trainControl(method = "cv",
                                          number = 5),
                 control = list(maxit = 50) #BROUGHT IN TO STOP WARNING MESSAGES
  )
  return(predict(model,
                 newdata = X,
                 type = "prob")[,1]) 
}

I get the following warning when this runs

glm.fit: fitted probabilities numerically 0 or 1 occurred

So I am clearly doing something wrong! I feel like fixing this function is probably the best approach but I don't see where I have gone wrong? I am following the approach I mentioned earlier, here

I get the sigmoid of the decision values as follows

sig_mult <-e1071::sigmoid(decision_values)

The examples were done using the Iris dataset, full code is here

data(iris)
two_class<-iris[iris$Species %in% c("setosa","versicolor"),]

#Make Two-class SVM 
svm_mult<-e1071::tune(svm,
                train.x = two_class[,1:4],
                train.y = factor(two_class[,5],levels=c("setosa", "versicolor")),
                type="C-classification", 
                kernel="radial",
                gamma=0.05, 
                cost=1,  
                probability = T,
                tunecontrol = tune.control(cross = 5))

#Get related decision values
dec_vals_mult <-attr(predict(svm_mult$best.model, 
                  two_class[,1:4], 
                  decision.values =  T #use decision values to get score
                  ), "decision.values")
#Get related probabilities
prob_mult <-attr(predict(svm_mult$best.model, 
                             two_class[,1:4], 
                             probability =  T #use decision values to get score
), "probabilities")[,1]

#transform decision values using sigmoid
sig_mult <-e1071::sigmoid(dec_vals_mult)
#Use Platt Implementation function to derive probabilities
platt_imp<-platt_scale(svm_mult,two_class[,1:4])

require(ggplot2)
data2<-as.data.frame(cbind(dec_vals_mult,sig_mult))
names(data2)<-c("Decision.Values","Sigmoid.Decision.Values(Prob)")
sig<-ggplot(data=data2,aes(x=Decision.Values,
                     y=`Sigmoid.Decision.Values(Prob)`,
                     colour=ifelse(Decision.Values<0,"neg","pos")))+
  geom_point()+
  ylim(0,1)+
  theme(legend.position = "none")

data3<-as.data.frame(cbind(dec_vals_mult,prob_mult))
names(data3)<-c("Decision.Values","Probabilities")
actual<-ggplot(data=data3,aes(x=Decision.Values,
                      y=Probabilities,
                      colour=ifelse(Decision.Values<0,"neg","pos")))+
  geom_point()+
  ylim(0,1)+
  theme(legend.position = "none")


data4<-as.data.frame(cbind(dec_vals_mult,platt_imp))
names(data4)<-c("Decision.Values","Platt")
plat_imp<-ggplot(data=data4,aes(x=Decision.Values,
                      y=Platt,
                      colour=ifelse(Decision.Values<0,"neg","pos")))+
  geom_point()+
  ylim(0,1)

require(ggpubr)
ggarrange(actual, plat_imp, sig,
          labels = c("Actual", "Platt Implementation", "Sigmoid Transformation"),
          ncol = 3,
          label.x = -.05,
          label.y = 1.001,
          font.label = list(size = 8.5, color = "black", face = "bold", family = NULL),
          common.legend = TRUE, legend = "bottom")