/*Source code for replication of the empirical results in Schneider/Finke/Bailer (2010) Bargaining Power in the European Union. Political Studies. vol. 58(1): 85-103.*/
/*Data is available from: http://..............*/

/*Part 3: The Saliency NBS*/
/*Example with three issue dimension*/

/*Global Parameter */
new;
library co; /* requires the Constrained Optimization Modul written by R.Schoenberg, copyright by Aptech Systems, Inc. */
screen off;
coset;
format /M1 /ROS 16,5;
cls;
_co_Algorithm = 3;
_co_LineSearch = 4;
_co_Bounds = {0 1};
_co_MaxIters = 5000;
_co_DirTol = 3*1e-5;

/*Loading preference data: rows->issues; cols 1-15-> member states; col 16-> European Parliament; col 17->Status quo*/
load ma[3,17] = "c:\\gauss9.0\\example1.txt";
/*Loading saliency data: rows->issues; rows 1-15-> member states; row 16-> European Parliament;*/
load S[3,16] = "c:\\gauss9.0\\saliency1.txt";


/*Starting Vector*/
t=zeros(3,1);
t[1] = sumc(diag(S[1,1:15].*ma[1,1:15]'))/sumc(S[1,1:15]');
t[2] = sumc(diag(S[2,1:15].*ma[2,1:15]'))/sumc(S[2,1:15]');
t[3] = sumc(diag(S[3,1:15].*ma[3,1:15]'))/sumc(S[3,1:15]');
x0=zeros(3,1)+meanc(t);

/*Calculating the adjusted Disagreement Value, see Schneider et al. (2007)*/
D = zeros(16,1);
i = 1;
do while i <= 16;
k=1;
do while k <= 3;
if ma[1,i] <0.5;
D[i] = D[i]+S[k,i]*(ma[k,i]-1)^2;
else; 
D[i] = D[i]+S[k,i]*(ma[k,i])^2;
endif;
k = k+1;
endo;
D[i] = sqrt(D[i]);
D[i] = D[i]*(1-1/15);
i= i+1;
endo; 



proc pareto(x);
local i, ui;

ui= D[1:15] - sqrt(diag(S[1,1:15].*((ma[1,1:15]-x[1])^2)')+diag(S[2,1:15].*((ma[2,1:15]-x[2])^2)')+diag(S[3,1:15].*((ma[3,1:15]-x[3])^2)'));

retp(minc(ui)-0);
endp;

/*Optimization*/
_co_InEqProc = &pareto;
{x, f, g, retcode } = co(&fsys, x0);

proc fsys (x);
local l3, l4;

l3 = D[1:15] - sqrt(diag(S[1,1:15].*((ma[1,1:15]-x[1])^2)')+diag(S[2,1:15].*((ma[2,1:15]-x[2])^2)')+diag(S[3,1:15].*((ma[3,1:15]-x[3])^2)'));
l3 = prodc(l3);

l4 = -1*l3;
retp((l4));
endp;

/*Return Results*/
call coPRT(x, f,g,retcode);

screen on;
print "x: " x;
print "function value " f;
print "Retour Code " retcode;