R/11.R

six.NH.1<-function(X,Y,kappa,theta1){
  
  n=length(X[2,]) # number of dimentions/attributes of X
  if(length(kappa)==1){
    kappa[2]=kappa[1]
  }
  
  ###calcmedv
  A=X[seq(along=Y)[Y==1],] # selecting class +1
  B=X[seq(along=Y)[Y==-1],] #selecting class -1
  m1=nrow(A)    # number of +1 class
  m2=nrow(B)  
  ## Statistics Measures
  mu=rbind(colMeans(A),colMeans(B))
  
  sigma=list(cov(A)+1e-7*diag(x=1,nrow = n , ncol = n),
             cov(B)+1e-7*diag(x=1,nrow = n , ncol = n))
  
  Mchol=list(t(chol(sigma[[1]])),t(chol(sigma[[2]]))) ##Sr but seem to be the same
  
  #######
  e1=cbind(rep(1,m1))
  e2=cbind(rep(1,m2))
  H= cbind(A,e1)
  G= cbind(B,e2)
  
  HH=t(H)%*%H
  HH = HH + theta1*diag(dim(HH)[2]) #regularization
  R1=chol(HH)
  rm(HH)
  
  GG=t(G)%*%G
  GG=GG + theta2*diag(dim(GG)[2])#%regularization
  R2=chol(GG)
  rm(GG)
  
  bb=-cbind(c(1,1,numeric(2*n+2)))
 
  ##  Building the 1st constraint
  At1=rbind(c(1,numeric(2*n+3)),cbind(matrix(0,nrow=n+1,ncol=2),R1,matrix(0,nrow=n+1,ncol=n+1)))
  c1=numeric(n+2)
  
  # Building the 2nd constraint
  At2=rbind(c(0,1,numeric(2*n+2)),cbind(matrix(0,nrow=n+1,ncol=n+3),R2))
  c2=numeric(n+2)
  
  # Building the 3rd constraint
  At3=matrix(0, nrow=n+1, ncol=2*n+4)
  c3=c(-1,numeric(n))
  At3[1,]=c(0,0,mu[1,],1,-mu[1,],-1) #first row
  At3[-1,]=cbind(0,0,kappa[1]*t(Mchol[[1]]),0,-kappa[1]*t(Mchol[[1]]),0) 
  
  
  ## Building the 4rt constraint
  At4=matrix(0, nrow=n+1,ncol=2*n+4)
  c4=c(-1,numeric(n))
  
  At4[1,3:(2*n+4)]=c(-mu[2,],-1,mu[2,],1) #first Row
  At4[-1,]=cbind(0,0,kappa[2]*t(Mchol[[2]]),0,-kappa[2]*t(Mchol[[2]]),0) 
  
  
  K.q=c(n+2, n+2, n+1, n+1) 
  ct=cbind(c(c1,c2,c3,c4))
  
  At=-rbind(At1,At2,At3,At4)
  ## Solve the SOC-problem with SCS
  cone <- list( q = K.q )
  
  scs <- scs(At, ct, -bb , cone)
  
  rm(At,At1, At2, c1, c2)
  
  w1=scs$x[3:(n+2)]
  b1=scs$x[n+3]
  w2=scs$x[(n+4):(2*n+3)]
  b2=scs$x[(2*n+4)]
  
  return(list(w1=w1,b1=b1,w2=w2,b2=b2))
  

}
cinthyaleonor/rsvmsocp documentation built on May 13, 2019, 7:30 p.m.