#!/usr/local/bin/maple
# -*- maplev -*-

# Nathaniel Shar
# HW 11
# Experimental Mathematics

# It is okay to link to this assignment on the course webpage.


Help := proc(): print(`LegalMoves(L,i), fW(L1,L2,r,i), FW(L1,L2,r), F(L,r), f(L,r,i), Exceptions3(N,j), ExceptionsK(N,r,K), Exceptions2(N, r), Exceptions4(N, r), LegalMovesG(Board, i), PWG(L1,L2,r), pWG(L1,L2,r,i)`): end:

# From c10.txt and c11.txt:

#LegalMoves(L,i): inputs a list of length nops(L)
#and a pos. integer i telling you that the option
#to move any counter i pieces towards the end
#without waste. And if you must waste, minimize it

LegalMoves:=proc(L,i) local S, j:

if i>nops(L) then
  RETURN(FAIL):
fi:

if L=[0$nops(L)] then
 RETURN({}):
fi:


S:={}:

if L[i]>0 then
  S:=S union {[op(1..i-1,L),L[i]-1,op(i+1..nops(L),L)]}:
fi:

for j from i+1 to nops(L) do

  if L[j]>0 then
#a counter distance j away goes to distance j-i away

 S:=S union {[op(1..j-i-1,L) , L[j-i]+1, op(j-i+1..j-1,L),
               L[j]-1, op(j+1..nops(L),L)]}:
  fi:


od:


if S<>{} then
  RETURN(S):
fi:


for j from i-1 by -1 to 1  while L[j]=0 do od:

{ [op(1..j-1,L),L[j]-1,op(j+1..nops(L),L)] }:

end:


#fW(L1,L2,r,i): The probability of L1 winning
#if the roll was i, followed by the optimal move
fW:=proc(L1,L2,r,i) local tom, champ,rec,mr:
option remember:

if L1=[0$nops(L1)] then
  RETURN(FAIL):
fi:

tom:=LegalMoves(L1,i):

if tom={} then
    RETURN(FAIL):
fi:

champ:=tom[1]:

rec:=1-FW(L2,champ,r):

for  mr in tom minus {tom[1]} do
 if 1-FW(L2,mr,r)>rec then
    champ:=mr:
     rec:=1-FW(L2,mr,r):
 fi:
od:

rec,champ:



end:

#FW(L1,L2,r): Probability of winning if your are about
#to roll and your position is L1 and your opponent's
#is L2 in a SINGLE r-faced fair die
FW:=proc(L1,L2,r) local  i:
option remember:

if L1=[0$nops(L1)] and L2<>[0$nops(L2)] then
 RETURN(1):
fi:

if L2=[0$nops(L2)] and L1<>[0$nops(L1)] then
 RETURN(0):
fi:
add(fW(L1,L2,r,i)[1], i=1..r)/r:

end:

F:=proc(L,r) local i:
option remember:


add(f(L,r,i)[2],i=1..r)/r:

end:

#f(L,r,i): inputs L and r as above and i between 1 and r
#and  outputs the OPTIMAL move, followed by the
#expected length if you do it
f:=proc(L,r,i) local rec,champ, Moves, hopeful:
option remember:
Moves:=LegalMoves(L,i):

if Moves={} then
  RETURN(FAIL,0):
fi:

champ:=Moves[1]:

rec:=F(champ,r):

for hopeful in Moves minus {Moves[1]} do

  if F(hopeful,r)<rec then
       champ:=hopeful:
        rec:=F(champ,r):
  fi:

od:

champ,rec+1:

end:

Exceptions3:=proc(N,j) local i1,i2,i3,j1,j2,j3,gu,P,Pw,lu1,lu2:

    gu:={}:

    for i1 from 0 to N do
        for i2 from 0 to N-i1 do
            for i3 from 1 to N-i1-i2 do

                for j1 from 0 to N do
                    for j2 from 0 to N-j1 do
                        for j3 from 1 to N-j1-j2 do


                            if f([i1,i2,i3],3,j)[1]<> fW([i1,i2,i3],[j1,j2,j3],3,j)[2] then:

                                P:=f([i1,i2,i3],3,j)[1]:

                                Pw:=fW([i1,i2,i3],[j1,j2,j3], 3,j)[2]:

                                if (FW([j1,j2,j3],P,3)-FW([j1,j2,j3],Pw,3) > 0) then:

                                    print(`In position `,[[i1,i2,i3],[j1,j2,j3]], `the strategies conflict when the die rolled`, j):
                                    print(`according to the minimize-expected length, the optimal move   is`):
                                    print(P):
                                    print(`according to the maximize the probability of winning, the optimal move   is`):
                                    print(Pw):

                                    lu1:=evalf(F(Pw,3)-F(P,3)):

                                    print(`The increase in expected duration if you follow the latter is`, lu1):

                                    lu2:=evalf(FW([j1,j2,j3],P,3)-FW([j1,j2,j3],Pw,3)):

                                    print(`The loss of proba. of winning if you follow the former is`,lu2):

                                    gu:=gu union {[[i1,i2,i3],[j1,j2,j3], P,Pw,lu1,lu2]}:
                                fi:
                            fi:

                        od:
                    od:
                od:

            od:
        od:
    od:

    gu:

end:


#############
# Problem 1 #
#############

# Note that procedure Exceptions3 had a bug (it could return true even
# if there was no loss in probability from following the
# length-minimizing strategy) and had to be altered.

# The smallest N for which Exceptions(N, 1) is nonempty is 5.
# Exceptions(N, 2) is empty for all N <= 15.


#############
# Problem 2 #
#############

with(combinat):

ExceptionsK := proc(N,r,K) local i, L, R, P, Pw, lu1, lu2, rv:
    rv := {}:
    for L in map(x->map(y->(y-1),x), composition(N+K, K)) do:
        for R in map(x->map(y->(y-1), x), composition(N+K, K)) do:
            if f(L,K,r)[1]<> fW(L,R,K,r)[2] then:
                P:=f(L,K,r)[1]:
                Pw:=fW(L,R, K,r)[2]:
                if (FW(R,P,K)-FW(R,Pw,K) > 0) then:

                    print(`In position `,[L,R], `the strategies conflict when the die rolled`, r):
                    print(`according to the minimize-expected length, the optimal move   is`):
                    print(P):
                    print(`according to the maximize the probability of winning, the optimal move   is`):
                    print(Pw):

                    lu1:=evalf(F(Pw,K)-F(P,K)):

                    print(`The increase in expected duration if you follow the latter is`, lu1):

                    lu2:=evalf(FW(R,P,K)-FW(R,Pw,K)):

                    print(`The loss of proba. of winning if you follow the former is`,lu2):

                    rv:=rv union {[L,R, P,Pw,lu1,lu2]}:
                fi:
            fi:
        od:
    od:
    return rv:
end:

Exceptions2 := proc(N, r):
    ExceptionsK(N, r, 2):
end:

# There is no N that works.

#############
# Problem 3 #
#############

Exceptions4 := proc(N, r):
    ExceptionsK(N, r, 4):
end:


# From hw10.txt:

LegalMovesG := proc(Board, i) local S, j, k:
    S := {}:
    for j from 1 to nops(Board) do:
        if j < i and Board[j] > 0 then:
            if {seq(Board[k], k=j+1..nops(Board))} = {0} then:
                S := S union {subsop(j=Board[j]-1, Board)}:
                return S:
            fi:
        elif j = i and Board[j] > 0 then:
            S := S union {subsop(j=Board[j]-1, Board)}:
            return S:
        elif Board[j] > 0 then:
            S := S union {subsop(j=Board[j]-1, j-i=Board[j-i]+1, Board)}:
            return S:
        fi:
    od:
end:

# The smallest N is 3.

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

PWG:=proc(L1,L2,r) local  i: option remember:

    if L1=[0$nops(L1)] and L2<>[0$nops(L2)] then
        RETURN(1):
    fi:

    if L2=[0$nops(L2)] and L1<>[0$nops(L1)] then
        RETURN(0):
    fi:
    add(pWG(L1,L2,r,i)[1], i=1..r)/r:

end:

pWG:=proc(L1,L2,r,i) local tom, champ,rec,mr:
option remember:

if L1=[0$nops(L1)] then
  RETURN(FAIL):
fi:

tom:=LegalMovesG(L1,i):

if tom={} then
    RETURN(FAIL):
fi:

champ:=tom[1]:

rec:=1-PWG(L2,champ,r):
return rec,champ:
end: