fork download 
  1. svm_gradient<- function(x,eta=0.001,R=10000){
  2.  
  3. X<- cbind(1,x)#make design matrix
  4. X
  5. n <- nrow(X)  #number of sample
  6. p <- ncol(X) #number of feature+1 (bias)
  7. w_intial <- rnorm(p,0,1)
  8. W <- matrix(w_intial ,nrow = R+1,ncol = p,byrow = T) #matrix put intial guess and the procedure to do gradient descent
  9.  
  10. for(i in 1:R){
  11.   for(j in 1:p)
  12.   {
  13.     W[i+1,j]<- W[i,j]+eta*sum(((y*(X%*%W[i,]))<1)*1 * y * X[,j] )  
  14.   }
  15.   }
  16.  
  17. return(W)  
  18. }
  19.  
  20. getsvm <- function(x){
  21.  
  22. w_answer<- svm_gradient(x)[nrow(svm_gradient(x)),]
  23. return(w_answer )
  24.  
  25. }
  26.  
  27.  
  28. ### sample
  29.  
  30. set.seed(2)
  31. n = 5
  32. a1 = rnorm(n)
  33. a2 = 1 - a1 + 2* runif(n)
  34. b1 = rnorm(n)
  35. b2 = -1 - b1 - 2*runif(n)
  36. x = rbind(matrix(cbind(a1,a2),,2),matrix(cbind(b1,b2),,2))
  37. y <- matrix(c(rep(1,n),rep(-1,n)))
  38. plot(x,col=ifelse(y>0,4,2),pch=".",cex=7,xlab = "x1",ylab = "x2")
  39. w_answer<- getsvm(x)
  40. abline(-w_answer[1]/w_answer[3],-w_answer[2]/w_answer[3])
  41. abline(1-w_answer[1]/w_answer[3],-w_answer[2]/w_answer[3],lty=2)
  42. abline(-1-w_answer[1]/w_answer[3],-w_answer[2]/w_answer[3],lty=2)
Success #stdin #stdout 0.76s 43288KB
comments (?)
stdin 
Standard input is empty
stdout 
Standard output is empty
https://ideone.com/qg0zVC
language:
R (R 3.5.2)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!