Wolfram Cloud Document

WOLFRAM NOTEBOOK

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[]:=