#returns 1, if x and y are not compatible with \leq 
###################################################
uncomppair = function(n,x,y) 
{ comp=0

  for (i in 1:n)
  { if (comp==0)
    { if (x[i]<y[i]) comp=-1
      if (x[i]>y[i]) comp= 1
    }
    if (comp==-1)
    { if (x[i]>y[i]) return (1)
    }
    if (comp== 1)
    { if (x[i]<y[i]) return (1)
    }
  }
  return (0) 
}


# Count the number of differencens of mA and mB
###############################################
matcompair = function(nobj, natt, mA, mB)
{  return ( sum ( (1-mA)*mB) + sum(mA*(1-mB) ) )
}


# Counts the number of incomparable elements 
# per attribute l and fixed vector m[k,]
############################################
mostconflict = function(nobj, natt, k, m, w) 
{ conf=rep(0, natt)

  for (l in 1:natt)
  { x=m[k,]
    x[l]=1-x[l]
    com = rep(0, nobj)

    for (i in 1:nobj)
    if (i!=k) com[i]= uncomppair(natt, m[i,], x)*w[k]*w[i]
    conf[l]=sum(com)
  } 
  return (conf)
}

attibute_bits = function(nobj, natt, m)
{ 
  attbit=rep(0,natt)
  for (k in 1:natt)
  { attbit[k] = min( sum(m[,k]), nobj-sum(m[,k]) )
  }
  return (attbit)
}

leave_one_out_complexity = function(nobj, natt, mall)
{
  weight=rep(1, nobj)
  errors=rep(-1,nobj)  
  attsom=rep(0, natt)
  for (k in 1:natt)
  { m=mall
    m[,k]=0

    for (i in 1:nobj)
    if (errors[i]!=0 && weight[i]>0)
    { for (j in 1:nobj)
        if (i!=j && errors[j]!=0 && weight[j]>0) attsom[k]= attsom[k] + uncomppair(natt, m[i,], m[j,])*weight[i]*weight[j]
    }
  } 
  
  attsom = attsom / nobj / (nobj-1)  
  return (attsom)
}  


clreduce = function (nobj, natt, m, maxiter=100, pout=.5)
{

mout=m
xerr=rep(0, maxiter)
bits=rep(0, maxiter+1)
weight=rep(1, nobj)
errors=rep(-1,nobj)
com=rep(0,nobj)
som=rep(1, nobj)

obj_chg=rep(0, maxiter)
att_chg=rep(0, maxiter)

ssom=100000
som_old=10000000
att_old=-1
obj_old=-1
minobj=1
minatt=0
isout=0

for (iter in 1:maxiter)
if (minobj>0 && som_old>=ssom)
{
   cat ("iter: ", iter, "\n")

   ### Sum of the number of incomparable objects
   for (i in 1:nobj)
   if (errors[i]!=0 && weight[i]>0)
   { for (j in 1:nobj)
       if (i!=j && errors[j]!=0 && weight[j]>0) com[j]= uncomppair(natt, m[i,], m[j,])*weight[i]*weight[j]
       som[i]=sum(com)
   }

   som_old=ssom
   ssom=sum(som)
   xerr[iter]=ssom

   if (ssom/nobj/(nobj-1)<=pout && isout==0)
   { mout=m
     isout=1
   }  
   
   cat("sumerr: ", ssom , "\n")

   ### Search for the best attribute ...

   minval=1000000000
   att_old=minatt
   obj_old=minobj
   minatt=-1
   minobj=-1
   maxsom=max(som)
      
   if (maxsom>0)
   { 
     for (i in 1:nobj)
     if (som[i]==maxsom)
     {  cf = mostconflict(nobj, natt, i, m, weight)
        
        # Exclude relation elements which are already changed   
        if (iter>1)
        { for (k in 1:(iter-1))
          { if (i==obj_chg[k]) cf[att_chg[k]]=10000000
          }
        } 
        mincf=min(cf)
        if (mincf<minval)
        { minval=mincf
          minobj=i
          for (j in 1:natt)
          { if (cf[j]==minval) minatt=j
          }
        }
     }
   }
   
   if (minobj>0) ## found!
   { m[minobj, minatt] = 1 - m[minobj, minatt]
     cat ("Obj= ", minobj, "; Attr= ", minatt, "; newerr= ", minval, "; newrel=", m[minobj, minatt], "\n")
     bits[iter+1] = bits[iter]+weight[i]
     obj_chg[iter]=minobj
     att_chg[iter]=minatt
   }

   errors=som
   niter=iter
}

xerr = xerr / nobj / (nobj-1)
plot(bits[1:niter], xerr[1:niter], xlab="Changed Bits", ylab="% of uncomparable pairs", ylim=c(0,1))
abline(a=0,b=0, lty=2)
abline(a=pout,b=0, lty=3)

if (isout==0) mout=m
# Returns first context with p<pout ("median context")
return(mout)
}

c1=c(1,1,0,0,0,0)
c2=c(1,0,0,0,0,0)
c3=c(0,1,1,1,0,0)
c4=c(0,0,0,0,1,0)
c5=c(1,0,0,0,0,1)
c6=c(0,1,0,0,0,0)
c7=c(0,0,1,0,0,0)
c8=c(1,0,1,0,0,0)
c9=c(1,0,0,1,0,0)
c10=c(1,0,0,1,0,0)
c11=c(0,0,0,1,1,0)
c12=c(0,0,0,0,0,1)
c13=c(1,0,1,0,1,0)
c14=c(1,1,1,1,1,1)
c15=c(1,0,0,0,0,0)
# Datenmatrix m
m=rbind(c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15)

clreduce(nobj=15, natt=6, m, pout=.5)
leave_one_out_complexity(nobj=15, natt=6, m)
attibute_bits(nobj=15, natt=6, m)

##################################################################################
# Example from Kumar & Srinivas (2010, p. 2700)
###############################################
x1=c(0,1,1,1,0,0,0,1,0,0,0,0,0,0,1,1)
x2=c(0,1,0,1,1,0,0,1,0,0,0,0,0,0,1,0)
x3=c(1,1,0,1,1,0,0,1,0,0,0,0,0,0,1,1)
x4=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x5=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0)
x6=c(1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x7=c(0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1)
x8=c(0,1,1,1,0,1,1,1,1,1,0,0,1,0,1,1)
x9=c(0,1,1,1,0,1,1,1,1,1,0,0,1,1,1,1)
x10=c(0,1,1,1,0,1,1,1,0,1,0,0,1,1,1,1)
x11=c(0,1,1,1,0,1,0,1,1,1,0,0,1,1,1,1)
x12=c(1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,0)
x13=c(1,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0)
x14=c(1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x15=c(0,0,1,1,1,0,1,0,0,0,0,1,0,0,0,0)
x16=c(0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,0)
x17=c(0,1,1,0,1,1,0,1,1,0,1,0,0,0,0,0)

# Datenmatrix m
m=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17)

clreduce(nobj=17, natt=16, m, pout=.14)
leave_one_out_complexity(nobj=17, natt=16, m)
attibute_bits(nobj=17, natt=16, m)


##################################################################################
# Example from Kumar & Srinivas (2010, p. 2699)
###############################################
x1=c(0,1,0,1,1,0,1)
x2=c(0,1,1,0,0,0,0)
x3=c(0,0,0,0,0,1,1)
x4=c(0,0,0,1,0,0,0)
x5=c(0,1,1,0,0,0,0)
x6=c(1,0,0,1,0,0,0)
x7=c(0,0,0,0,1,1,0)
x8=c(0,0,1,1,0,0,0)
x9=c(1,0,0,1,0,0,0)

m=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9)

clreduce(nobj=9, natt=7, m, pout=0.0001)
leave_one_out_complexity(nobj=9, natt=7, m)
attibute_bits(nobj=9, natt=7, m)

mt=t(m)
clreduce(nobj=7, natt=9, mt, pout=0.5)

##################################################################################
# Example from Kumar & Srinivas (2010, p. 2699) - reduced Context
###############################################
x1=c(1,1,0,1)
x2=c(1,0,0,0)
x3=c(0,0,1,1)
x4=c(1,0,0,0)
x5=c(1,0,0,0)
x6=c(1,0,0,0)
x7=c(0,1,1,0)
x8=c(1,0,0,0)
x9=c(1,0,0,0)

m=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9)

clreduce(nobj=9, natt=4, m)
#leave_one_out_complexity(nobj=9, natt=4, m)
#attibute_bits(nobj=9, natt=4, m)

mt=t(m)
clreduce(nobj=4, natt=9, mt)

x1=c(1,1,1,1,1,0,1)
x2=c(1,1,1,1,0,0,0)
x3=c(0,0,0,0,0,1,1)
x4=c(1,1,1,1,0,0,0)
x5=c(1,1,1,1,0,0,0)
x6=c(1,1,1,1,0,0,0)
x7=c(0,0,0,0,1,1,0)
x8=c(1,1,1,1,0,0,0)
x9=c(1,1,1,1,0,0,0)

m=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9)

x1=c(0,1,0,1,1,0,1)
x2=c(0,1,1,0,0,0,0)
x3=c(0,0,0,0,0,1,1)
x4=c(0,0,0,1,0,0,0)
x5=c(0,1,1,0,0,0,0)
x6=c(1,0,0,1,0,0,0)
x7=c(0,0,0,0,1,1,0)
x8=c(0,0,1,1,0,0,0)
x9=c(1,0,0,1,0,0,0)

mA=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9)

matcompair(nobj=9, natt=7, mA, m)

##################################################################################
# Example from Kumar & Srinivas (2010, p. 2700) reduced context (k=5)
###############################################
x1=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x2=c(0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
x3=c(0,1,0,1,0,0,0,0,0,0,0,0,0,0,1,0)
x4=c(0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
x5=c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
x6=c(0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
x7=c(0,1,1,1,0,1,1,1,0,1,0,0,0,0,1,1)
x8=c(0,1,1,1,0,1,1,1,0,1,0,0,0,0,1,1)
x9=c(0,1,1,1,0,1,1,1,1,1,0,0,1,1,1,1)
x10=c(0,1,0,1,0,0,0,1,0,1,0,0,1,1,1,1)
x11=c(0,1,1,0,0,1,0,1,1,1,0,0,1,1,1,1)
x12=c(0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x13=c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
x14=c(0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x15=c(0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x16=c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
x17=c(0,1,1,0,0,1,0,0,1,0,0,0,0,0,0,0)
				    

# Datenmatrix m
m=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17)

clreduce(nobj=17, natt=16, m, pout=.2)
leave_one_out_complexity(nobj=17, natt=16, m)
attibute_bits(nobj=17, natt=16, m)

x1=c(0,1,1,1,0,0,0,1,0,0,0,0,0,0,1,1)
x2=c(0,1,0,1,1,0,0,1,0,0,0,0,0,0,1,0)
x3=c(1,1,0,1,1,0,0,1,0,0,0,0,0,0,1,1)
x4=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x5=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0)
x6=c(1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x7=c(0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1)
x8=c(0,1,1,1,0,1,1,1,1,1,0,0,1,0,1,1)
x9=c(0,1,1,1,0,1,1,1,1,1,0,0,1,1,1,1)
x10=c(0,1,1,1,0,1,1,1,0,1,0,0,1,1,1,1)
x11=c(0,1,1,1,0,1,0,1,1,1,0,0,1,1,1,1)
x12=c(1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,0)
x13=c(1,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0)
x14=c(1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x15=c(0,0,1,1,1,0,1,0,0,0,0,1,0,0,0,0)
x16=c(0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,0)
x17=c(0,1,1,0,1,1,0,1,1,0,1,0,0,0,0,0)

# Datenmatrix m
mA=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17)

matcompair(nobj=17, natt=16, mA, m)

##################################################################################
# Example from Kumar & Srinivas (2010, p. 2700) reduced context (k=9)
###############################################
x1=c(0,1,1,1,0,0,0,1,0,0,0,0,0,0,1,1)
x2=c(0,1,0,1,0,0,0,1,0,0,0,0,0,0,1,0)
x3=c(1,1,0,1,1,0,0,1,0,0,0,0,0,0,1,1)
x4=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x5=c(0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0)
x6=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x7=c(0,1,1,1,0,1,1,1,1,1,0,0,0,0,1,1)
x8=c(0,1,1,1,0,1,1,1,1,1,0,0,0,0,1,1)
x9=c(0,1,1,1,0,1,1,1,1,1,0,0,1,1,1,1)
x10=c(0,1,1,1,0,1,1,1,0,1,0,0,1,1,1,1)
x11=c(0,1,1,1,0,1,0,1,1,1,0,0,1,1,1,1)
x12=c(0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x13=c(0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0)
x14=c(0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x15=c(0,0,1,1,0,0,1,0,0,0,0,1,0,0,0,0)
x16=c(0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0)
x17=c(0,1,1,0,1,1,0,1,1,0,1,0,0,0,0,0)

# Datenmatrix m
m=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17)

clreduce(nobj=17, natt=16, m, pout=.5)
leave_one_out_complexity(nobj=17, natt=16, m)
attibute_bits(nobj=17, natt=16, m)

x1=c(0,1,1,1,0,0,0,1,0,0,0,0,0,0,1,1)
x2=c(0,1,0,1,1,0,0,1,0,0,0,0,0,0,1,0)
x3=c(1,1,0,1,1,0,0,1,0,0,0,0,0,0,1,1)
x4=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x5=c(0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0)
x6=c(1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0)
x7=c(0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1)
x8=c(0,1,1,1,0,1,1,1,1,1,0,0,1,0,1,1)
x9=c(0,1,1,1,0,1,1,1,1,1,0,0,1,1,1,1)
x10=c(0,1,1,1,0,1,1,1,0,1,0,0,1,1,1,1)
x11=c(0,1,1,1,0,1,0,1,1,1,0,0,1,1,1,1)
x12=c(1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,0)
x13=c(1,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0)
x14=c(1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0)
x15=c(0,0,1,1,1,0,1,0,0,0,0,1,0,0,0,0)
x16=c(0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,0)
x17=c(0,1,1,0,1,1,0,1,1,0,1,0,0,0,0,0)

# Datenmatrix m
mA=rbind(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17)

matcompair(nobj=17, natt=16, mA, m)

###################################################################################