# OK to post homework
# Lucy Martinez, 03-27-22, Assignment 16
read `C16.txt`:
with(combinat):
#----------------------Problem 2-----------------------#
# Write a one-line procedure IsCondorcet(P)
# that inputs a voting profile P with v:=nops(P) voters and n:=nops(P[1]) candidates, and outputs true 
# iff you have an instance of the Condorcet paradox. For example IsCondorect([[1,2,3],[2,3,1],[3,1,2]]);
# should be "true" but IsCondorect([[1,2,3],[1,2,3],[1,3,2]]); should be "false"
# (Hint, a voting profile P is Condorcet iff SV(Tour(P)) is NOT a permutation of [0,1,..., n-1])

IsCondorcet:=proc(P) local n,perm,i :
n:= nops(P[1]):
perm:= permute([seq(i,i=0..n-1)]):
if member(SV(Tour(P)), perm)=true then
 RETURN(false):
fi:
true:
end:
IsCondorcet([[1,2,3],[1,2,3],[1,3,2]]);
#              false



IsCondorcet([[1,2,3],[2,3,1],[3,1,2]]);
#               true


#----------------------Problem 3-----------------------#
# Write a procedure ExactCond(n,v) that inputs positive integres n and v and outputs the EXACT ratio of 
# voting profiles that are Condorcet

ExactCond:=proc(n,v) local P, co,i:
P:=RP(n,v):
co:=0:
for i from 1 to nops(P) do
 if IsCondorcet(P[i]) then
  co:=co+1:
 fi:
od:
evalf(co/((n!)^v)):
end:
[seq(ExactCond(3,i),i=3..5)];
#       [0.05555555556, 0.06944444444, 0.06944444444]


#----------------------Problem 4-----------------------#
# Write a procedure EstCond(n,v,K)
# that inputs a large positive integer K, and integers n and v , and generates K random voting profiles with v 
# voters and n candidates, and oututs the ratio (in floatig points) of those that happen to be Condorcet.
# Check it against ExactCond(n,v) for n=3 and v=3,4,5.
# For each of n=3,4,5, and v=20,30,40, run EstCond(n,v,10000) several times, make sure that you get close answers.
# Do you see a trend?

EstCond:=proc(n,v,K) local co,i,P:
co:=0:
for i from 1 to K do
P:=RandP(n,v):
 if IsCondorcet(P) then
  co:=co+1:
 fi:
od:
evalf(co/K):
end: 
[seq(EstCond(i,20,10000), i=3..5 )];
#       [0.08770000000, 0.2480000000, 0.4629000000]


[seq(EstCond(i,30,10000), i=3..5 )];
#       [0.08280000000, 0.2485000000, 0.4629000000]


[seq(EstCond(i,40,10000), i=3..5 )];
#       [0.08660000000, 0.2538000000, 0.4684000000]


#----------------------Problem 5-----------------------#
# Look up "Borda count" and write a procedure Borda(P) that inputs a voting profile P and outputs the Borda score
# of the n candidates.

Borda:= proc(P) local n,v,i,j,S :
n:=nops(P[1]):
v:=nops(P):
for i from 1 to n do
 S[i]:=0:
od:

for i from 1 to v do
 for j from 1 to n do
  S[j]:=S[j] + n - inv(P[i])[j]: # inv gets position of the candidate j
 od:
od:
[seq(S[i],i=1..n)]:
end:

Borda([[1,2,3],[2,3,1],[2,3,1]]);
#                  [2, 5, 2]


#----------------------Problem 6-----------------------#
# Write a procedure CondorcetRank(P) that inputs a voting profile P and outputs the ranking according
# to the Condorcet criterion. For example, CondorcetRank([[1,2,3],[1,2,3],[1,2,3]]) should output [{1},{2},{3}]
# while CondorcetRank([[1,2,3],[2,3,1],[3,1,2]]) should output [{1,2,3}]
# The following is old code from class

CondorcetRank:=proc(P) local S,added, T,i,j,k,l,temp:
S:=SV(Tour(P)):
added:=[]:
T:=[]:
for i from 1 to nops(S) do
 if member(i,added)=false then
  T:=[op(T),{i}]:
  added:=[op(added),i]:
  for j from i+1 to nops(S) do
   if S[i]=S[j] then
    T[i]:=T[i] union {j}:
    added:=[op(added),j]:
   fi:
  od:
 fi:
od:
 
temp:=0:
for k from 1 to nops(T) do
for l from k+1 to nops(T) do
 if S[T[k,1]]<S[T[l,1]] then
  temp:=T[k]:
  T:=subsop(k=T[l],T): 
  T:=subsop(l=temp,T):
 fi:
od:
od:

T:
end:

SV(Tour([[1,2,3],[1,2,3],[1,2,3]]));
CondorcetRank([[1,2,3],[1,2,3],[1,2,3]]);
#                     [2, 1, 0]
#                  [{1}, {2}, {3}]


SV(Tour([[1,2,3],[2,3,1],[3,1,2]]));
CondorcetRank([[1,2,3],[2,3,1],[3,1,2]]);
#                     [1, 1, 1]
#                    [{1, 2, 3}]


#----------------------Problem 7-----------------------#
# Write a procedure BordaRank(P) that inputs a voting profile P and outputs the ranking according
# to the Borda criterion. For example, BordaRank([[1,2,3],[1,2,3],[1,2,3]]); should output [{1},{2},{3}]
# while BordaRank([[1,2,3],[2,3,1],[3,1,2]]); should output [{1,2,3}]

BordaRank:=proc(P) local S,added, T,i,j,k,l,temp:
S:=Borda(P):
added:=[]:
T:=[]:
for i from 1 to nops(S) do
 if member(i,added)=false then
  T:=[op(T),{i}]:
  added:=[op(added),i]:
  for j from i+1 to nops(S) do
   if S[i]=S[j] then
    T[i]:=T[i] union {j}:
    added:=[op(added),j]:
   fi:
  od:
 fi:
od:
  
temp:=0:
for k from 1 to nops(T) do
for l from k+1 to nops(T) do
 if S[T[k,1]]<S[T[l,1]] then
  temp:=T[k]:
  T:=subsop(k=T[l],T): 
  T:=subsop(l=temp,T):
 fi:
od:
od:
 
T:
end:

BordaRank([[1,2,3],[1,2,3],[1,2,3]]);
#              [{1}, {2}, {3}]


BordaRank([[1,2,3],[2,3,1],[3,1,2]]);
#                [{1, 2, 3}]