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

/*Part 2: The Two-level NBS & the  Asymmetric 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 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 power index: cols-> rows 1-15-> member states; row 16-> European Parliament*/
load PP[1,16] = "c:\\gauss9.0\\power1.txt";
PP= PP';
PP[1:15,1] = PP[1:15,1]./sumc(PP[1:15,1]);/*Standardization excl. the European Parliament !*/

/*Starting Vector*/
x0= zeros(3,1)+meanc(meanc(ma[1:3,1:15]'));

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

proc pareto(x);
local i, ui;

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

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

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

proc fsys (x);
local l3, l4;

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

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;