1
$\begingroup$

I have written an R code for soft margin svm using the ipop function of kernlab package. Despite it's working fine, but I still have some doubt whether this code working properly or not. According to the literature large value of cost parameter leads to less classification error and smaller margin and small value of cost leads to bigger margin and more classification error. But this property is not satisfy in my function. For example set.seed(72), the margin for cost=100, 1000 are larger than the cost=1, while it's supposed to be narrower. Any help would be appreciated.

    softmargin=function(x,y,cost,x.test,y.test)
    {
    library(kernlab)
    #----------------------------------------------------#
    # Optimization uing ipop() function of kernlab package
    #----------------------------------------------------#
    n <- dim(x)[1]
    Q <- sapply(1:n, function(i) y[i]*t(x)[,i])
    D <- t(Q)%*%Q
    d <- matrix(1, nrow=n)
    uu <- cost   
    eps <- 1e-2    
    b <- 0
    r <- 0
    A2 <- t(y)
    l <- matrix(0, nrow=n, ncol=1)
    u <- matrix(uu, nrow=n, ncol=1)

    capture.output(sol <- ipop(-d, t(Q)%*%Q+eps*diag(n), A2, b, l, u, 
    r,verb =  TRUE,   sigf=5, margin=1e-8))
    ipopsol <- primal(sol)
    alpha<- matrix(ipopsol , nrow=n)

    #--------------------------------------------------#
    # Calculation of the normal vector W and bias term b
    #--------------------------------------------------#
    w=t(alpha*y)%*%(x) #W
    ff=matrix(rep(alpha*y,n),n,n)*x%*%t(x)
    fout=matrix(t(apply(ff,2,sum)))
    pos=which(alpha>1e-6)
    b = mean(y[pos]-fout[pos]) #b
    fx=t(w %*% t(as.matrix(x))) + b # the classifiying function f(x)=wx+b 
    fx.test=t(w %*% t(as.matrix(x.test))) + b 
    # the predicted classifying function for the test set data

    #-----------------------------#
    #    SVM line & support vectors
    #-----------------------------#
    plot(x,pch=ifelse(y==1, 1, 3),col=ifelse(y==1, 1, 2),main="Soft 
    margin SVM")
    abline(-b/w[1,2], -w[1,1]/w[1,2], col="black", lty=1)
    abline(-(b+1)/w[1,2],-w[1,1]/w[1,2], col="orange", lty=3)
    abline(-(b-1)/w[1,2], -w[1,1]/w[1,2], col="orange", lty=3)
    points(x[pos,],col="blue",cex=2) # show the support vectors

    #--------------------------#
    #   Computation of  ACCURACY
    #--------------------------#
    pred<-function(x,lable){
    C=NULL
    for (i in 1:length(x)){
    if(x[i]>0){C[i]=1}
    else {C[i]=-1}
    }
    accuracy=mean(C==lable)
    result=list(C,accuracy)
    return(accuracy)
    }
    pred(fx.test,y.test)
    }

    #---------------------#
    #         DATA        #
    #---------------------#
    set.seed(72 )#118  train set
    groupP<- cbind(1,matrix(rnorm(20),10,2))
    groupN<- cbind(-1,matrix(rnorm(20,mean=-1,sd=1),10,2))
    x=rbind(groupP[,-1],groupN[,-1])
    y=c(rep(1,nrow(groupP)),rep(-1,nrow(groupN)))

    set.seed(8)#  test set
    groupPt<- cbind(1,matrix(rnorm(10),5,2))
    groupNt<- cbind(-1,matrix(rnorm(10,mean=-1,sd=1),5,2))
    x.test=rbind(groupPt[,-1],groupNt[,-1])
    y.test=c(rep(1,5),rep(-1,5))


    softmargin(x,y,10,x.test,y.test)
$\endgroup$
  • $\begingroup$ My guess is that the problem is that the would be support vectors samples lie on a line and collinearity breaks everything. Did you solve it in the meantime? $\endgroup$ – rep_ho Mar 8 '16 at 2:05
  • $\begingroup$ Thanks for your answer. I ask an expert and he said that it is depends on the sparseness of the data. If the data set be sparse this might be happen! What is your idea? $\endgroup$ – user2802663 Mar 8 '16 at 11:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.