#Please do not post homework
#AJ Bu, March 21 2022, Assignment 16


####################	Problem 2	####################
#IsCondorcet(P): inputs a voting profile P with v:=nops(P) voters
#and n:=nops(P[1]) candidates.  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"

IsCondorcet:=proc(P) local i:
	evalb( {op(SV(Tour(P)))}={seq(i,i=0..nops(P[1])-1)}):
end:



####################	Problem 3	####################
#ExactCond(n,v): inputs positive integers n and v and outputs the 
#EXACT ratio of voting profiles that are Condorcet.


ExactCond:=proc(n,v) local co,P,m,p:
	co:=0:
	P:=RP(n,v):	
	m:=nops(P):

	for p in P do
		if IsCondorcet(p) then
			co:=co+1:
		fi:
	od:

	co/m:
end:


####################	Problem 4	####################

#EstCond(n,v,K): inputs K random voting profiles (where K is large) and 
#outputs the ratio (in floating points) of those that happen to be Condorcet.

EstCond:=proc(n,v,K) local i,P,co:
	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:



#ExactCond(3,3)
##	1/18

#ExactCond(3,4)
##	5/72
                             
#ExactCond(3,5)
##	5/72


#EstCond(3,3,10000)
##	.05500000000

#EstCond(3,4,10000)
##	0.07050000000

#EstCond(3,5,10000)
##	0.06770000000


#These are pretty close to the ExactCond values.

#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?


#For n=3 and v=20 all of them were close to
#	0.084

#For n=3 and v=30 all of them were close to
#	0.086

#For n=3 and v=40 all of them were close to
#	0.085


#For n=4 and v=20 all of them were close to
#	0.252

#For n=4 and v=30 all of them were close to
#	0.253

#For n=4 and v=40 all of them were close to
#	0.256


#For n=5 and v=20 all of them were close to
#	0.456

#For n=5 and v=30 all of them were close to
#	0.462

#For n=5 and v=40 all of them were close to
#	0.463


####################	Problem 5	####################
#Borda(P): inputs a voting profile P and outputs the Borda score of the n candidates.


Borda:=proc(P) local pi, P1:
	P1:=[seq( [nops(P[1])$nops(P[1])] - inv(pi), pi in P)]:
	add(P1):
end:




####################	Problem 6	####################
#CondorcetRank(P): 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}]


CondorcetRank:=proc(P) local S, rank, i ,j:
	S:=SV(Tour(P)):
	rank:=[{1}]:
	for i from 2 to nops(S) do 
		for j from 1 to nops(rank) do
			if S[i]>S[rank[j][1]] then  
				rank:=[op(1..j-1,rank), {i}, op(j..nops(rank),rank)]:
				j:=nops(rank)+2:
			elif S[i]=S[rank[j][1]] then  
				rank:= [op(1..j-1,rank), {op(rank[j]),i  }, op(j+1..nops(rank),rank)]:
				j:=nops(rank)+2:
			fi:
		od:
	
		if j=nops(rank)+1 then 
			rank:=[op(rank), {i}]:
		fi:
		
	od:
rank:
end:


####################	Problem 7	####################
#BordaRank(P): inputs a voting profile P and 
#outputs the ranking according to the Borda Count. 
#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 B, rank, i ,j:
	B:=Borda(P):
	rank:=[{1}]:
	for i from 2 to nops(B) do 
		for j from 1 to nops(rank) do
			if B[i]>B[rank[j][1]] then  

				rank:=[op(1..j-1,rank), {i}, op(j..nops(rank),rank)]:
				j:=nops(rank)+2:
			elif  B[i]=B[rank[j][1]] then  
				rank:= [op(1..j-1,rank), {op(rank[j]),i  }, op(j+1..nops(rank),rank)]:
				j:=nops(rank)+2:
			fi:
		od:
	
		if j=nops(rank)+1 then 
			rank:=[op(rank), {i}]:
		fi:
		
	od:
rank:
end:

########################################	From C16.txt	########################################



#C16.txt, March 21, 2022; Starting Social Choice theory
Help16:=proc(): print(`RP(n,v), inv(pi) , Cij(P,i,j), RandP(n,v), Tour(P), SV(T) `): 
end:

with(combinat):

#inv(pi): the inverse of the permutation pi
inv:=proc(pi) local T,i:
for i from 1 to nops(pi) do
T[pi[i]]:=i:
od:
[seq(T[i],i=1..nops(pi))]:
end:

#RandP(n,v)
RandP:=proc(n,v) local i:
[seq(randperm(n),i=1..v)]:
end:

#RP(n,v): all the possible voting profiles with n candidates {1,...n}
#[[1,3,2],[2,1,3]],   [1,3,2]-> [[1,3,2]]
RP:=proc(n,v) local S,P1,p,s:
option remember:
S:=permute(n):
if v=1 then
 RETURN( {seq([s]  , s in S)}):
fi:
P1:=RP(n,v-1):
{seq(seq([op(p),s],s in S),p in P1)}:
end:


#Cij(P,i,j): inputs a voting profile P and candidates i and  j how many
#voters pefer i to j?
Cij:=proc(P,i,j) local k1,co,pi:
co:=0:

for k1 from 1 to nops(P) do
pi:=inv(P[k1]):
if pi[i]<pi[j] then
 co:=co+1:
fi:
od:
co:
end:

#Tour(P): inputs a voting profile and outputs the torunament
#M[i,j]=1 if i beat j otherwise -1, M[i,i]=0
Tour:=proc(P) local n,T,i,j:
n:=nops(P[1]):
for i from 1 to n  do
T[i,i]:=0:
od:

for i from 1 to n do
 for j from i+1 to n do
 if Cij(P,i,j)>Cij(P,j,i) then
  T[i,j]:=1:
   T[j,i]:=-1:
   else
  T[i,j]:=-1:
  T[j,i]:=1:
 fi:
od:
od:
[seq([seq(T[i,j],j=1..n)],i=1..n)]:
end:

#SV(T): inputs a tournament (as a list of lists) with n players
#n=nops(T), and outputs the vector V[i]: how many other candiates did
#candidate i beat
 SV:=proc(T) local n, S,i,j:
n:=nops(T):

for i from 1 to n do
 S[i]:=0:
od:

for i from 1 to n do
 for j from i+1 to n do
   if T[i][j]=1 then
    S[i]:=S[i]+1:
    elif T[i][j]=0 then
      S[i]:=S[i]+1/2:
       S[j]:=S[j]+1/2:
    else
     S[j]:=S[j]+1:
    fi:
od:
od:

[seq(S[i],i=1..n)]:
    
end: