In[]:=
medals={​​{"CountryA",10,5,1},​​{"CountryB",8,7,3},​​{"CountryC",6,9,4},​​{"CountryD",7,6,2},​​{"CountryE",15,4,2},​​{"CountryF",3,12,8},​​{"CountryG",9,3,5},​​{"CountryH",4,10,6},​​{"CountryI",5,8,7},​​{"CountryJ",11,2,3}​​};​​numCountries=Length[medals];
​
(*OPTIMIZATIONFUNCTION*)​​(*maximize=truemeansfindmaxrank,falsemeansminrank*)​​OptimizeRank[k_Integer,maximize_:True]:=​​Module[{wG,wS,scores,zVars,M=10^6,epsilon=1,obj,vars,cons,solution},​​​​(*Definethevariables*)​​wG=Symbol["wG"];(*Defineweightsassymbolic*)​​wS=Symbol["wS"];​​scores=Table[wG*medals[[i,2]]+wS*medals[[i,3]]+medals[[i,4]],{i,numCountries}];​​zVars=Table[If[i≠k,z[i],Sequence[]],{i,numCountries}];(*Definezvariablesforallcountriesexceptk*)​​​​(*Constraints*)​​ cons=Join[​​Flatten[Table[​​If[i≠k,​​{scores[[i]]≥scores[[k]]+epsilon-M*(1-z[i]),scores[[i]]≤scores[[k]]+M*z[i]},​​Nothing],​​{i,numCountries}​​]​​],​​Flatten[Table[​​If[i≠k,​​{0≤z[i]≤1},​​Nothing],​​{i,numCountries}​​]​​],​​{1≤wS≤20,wS≤wG≤20}​​];​​​​(*Objectivefunction*)​​obj=If[maximize,-1,1]*(Total[Table[If[i≠k,z[i],0],{i,numCountries}]]+1);(*Negateformaximization,asLinearOptimizationminimizesbydefault*)​​​​vars=Join[{wG,wS},Table[If[i≠k,z[i]∈Integers,Nothing],{i,numCountries}]];​​​​ (*Solvetheoptimizationproblem*)​​solution=LinearOptimization[obj,cons,vars];​​​​ (*uncommentifyouwanttheactualweights*)​​ (*{If[maximize,-1,1]*obj/.solution,solution}*)​​ If[maximize,-1,1]*obj/.solution​​]
​
In[]:=
(*CADfunction*)​​FindRankConditions[k_Integer,r_Integer]:=Module[​​{scores,zVars,booleanExpressions,totalConstraint,allExpressions,result,wG,wS,n},​​  ​​wG=Symbol["wG"];(*Defineweightsassymbolic*)​​wS=Symbol["wS"];​​  ​​scores=Table[wG*medals[[i,2]]+wS*medals[[i,3]]+medals[[i,4]],{i,numCountries}];(*Calculatescoresforeachcountry*)​​  ​​n=Length[medals];(*Numberofcountries*)​​  ​​zVars=Table[If[i≠k,z[i],Sequence[]],{i,numCountries}];(*Definezvariablesforallcountriesexceptk*)​​  ​​booleanExpressions=Table[​​If[i≠k,​​And[​​Implies[scores[[i]]>scores[[k]],z[i]==1],​​Implies[scores[[i]]≤scores[[k]],z[i]==0]​​],​​Nothing],​​{i,Length[scores]}​​];​​​​totalConstraint=Total[Table[If[i≠k,zVars[[i]],0],{i,numCountries}]]==r-1;(*Addtheconstraintthatthesumofallz[i]r-1*)​​allExpressions=Flatten[{Select[booleanExpressions,#=!=Nothing&],totalConstraint,{1≤wS≤20,wS≤wG≤20}}];(*IncludeallconstraintsintheCADcomputation*)​​​​ result=Reduce[allExpressions,Join[{wS,wG},zVars]];(*Computethecylindricalalgebraicdecomposition*)​​result/.{_==_Sequence[],z[_]==_Sequence[]}(*Returntheresultwithoutz*)​​];
In[]:=
Table[OptimizeRank[i,False],{i,numCountries}]
LinearOptimization
:Warning: integer linear programming will use a machine-precision approximation of the inputs.
LinearOptimization
:Warning: integer linear programming will use a machine-precision approximation of the inputs.
LinearOptimization
:Warning: integer linear programming will use a machine-precision approximation of the inputs.
General
:Further output of LinearOptimization::lpip will be suppressed during this calculation.
Out[]=
{2,2,3,6,1,1,3,3,3,2}
In[]:=
Table[OptimizeRank[i,True],{i,numCountries}]
LinearOptimization
:Warning: integer linear programming will use a machine-precision approximation of the inputs.
LinearOptimization
:Warning: integer linear programming will use a machine-precision approximation of the inputs.
LinearOptimization
:Warning: integer linear programming will use a machine-precision approximation of the inputs.
General
:Further output of LinearOptimization::lpip will be suppressed during this calculation.
Out[]=
{8,6,7,10,2,10,10,10,10,8}
In[]:=
OptimizeRank[3,True]
LinearOptimization
:Warning: integer linear programming will use a machine-precision approximation of the inputs.
Out[]=
7
In[]:=
cadOutput=FindRankConditions[7,6]
Out[]=
1≤wS≤
14
13
&&
1
3
(-1+6wS)≤wG<
1
4
(2+5wS)||
14
13
<wS<
13
12
&&
1
3
(-1+6wS)≤wG≤4-2wS||wS
13
12
&&wG
11
6
||1<wS≤
14
13
&&4-2wS<wG<
1
2
(1+3wS)||
14
13
<wS≤
10
9
&&
1
4
(2+5wS)≤wG<
1
2
(1+3wS)||
10
9
<wS<
5
3
&&
1
3
(-1+6wS)≤wG<
1
2
(1+3wS)||
5
3
<wS≤
61
6
&&
1
2
(1+3wS)≤wG<
1
3
(-1+6wS)||
61
6
<wS<13&&
1
2
(1+3wS)≤wG≤20||(wS13&&wG20)
In[]:=
RegionPlot[cadOutput,{wS,1,20},{wG,1,20},FrameLabel{"Weight of silver (wS)","Weight of gold (wG)"}]
Out[]=