loading
main.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
/////////////MISC SKIP//////////////////
open System
let random = new Random()  

module Array =
   let indexed a = Array.mapi (fun i x -> (i,x)) a
   let selectColumn c a = 
       Array.map (indexed >> Array.filter (fst >> (=) c) >> Array.map snd) a  

module String = 
   let pad padlen (s:string) = s + String.replicate (max 0 (padlen - s.Length)) " "
   let inline toupper (str:string) = str.ToUpper()
   

let inline joinToStringWith sep (s:'a seq) = String.Join(sep, s)

let buildTableRow (collens:_[]) (row:string[]) =
       row |> Array.mapi (fun i s ->  String.pad collens.[i] s) |> joinToStringWith " | "

let makeTable newline headers title (table:string[][]) =
       let hlen = Array.map String.length headers

       let lens = table |> Array.map (Array.map (String.length))

       let longest = [|for c in 0..headers.Length - 1 -> max hlen.[c] (Array.selectColumn c lens |> Array.map Seq.head |> Array.max)|]

       let t0 = table |> Array.map (buildTableRow longest) |> joinToStringWith newline

       let hrow = [|headers; [|for i in 0..headers.Length - 1 -> String.replicate longest.[i] "-"|]|] 
                  |> Array.map (buildTableRow longest) 
                  |> joinToStringWith newline
       String.Format("{0}{1}{1}{2}{1}{3}", (String.toupper title), newline, hrow, t0)


let cdf p = 
    p |> Array.fold (fun (total, list) v -> 
                let cd = v + total
                cd, cd::list) (0., []) 
      |> snd 
      |> Array.ofList 

let getDiscreteSampleFromCDF (pcdf:float[]) = 
    let k, pcdlen = random.NextDouble() * pcdf.[0], pcdf.Length - 1
    
    let rec cummProb idx = if k > pcdf.[idx] then cummProb (idx - 1) else idx
    
    abs(cummProb pcdlen - pcdlen) 

let discreteSample p = cdf p |> getDiscreteSampleFromCDF  

let inline pairop op (x,y) (u,v) = (op x u, op y v)

let round (n:int) (x:float) = Math.Round(x,n)                                                                               
                         
let selectColumn c a = Array.map (Array.indexed >> Array.filter (fst >> (=) c) >> Array.map snd) a 

let getStrategy (strategySum:_[]) regretSum =
  let strategy         = Array.map (max 0.)  regretSum 
  let nSum, numactions = Array.sum strategy, strategy.Length
  
  let strategy' = 
      if nSum <= 0. then 
           Array.create numactions (1./float numactions) 
      else Array.map (fun x -> x/nSum) strategy
  
  for a in 0..numactions - 1 do strategySum.[a] <- strategySum.[a] + strategy'.[a]
  strategy'

let getAvgStrategy strategySum =  
  let nSum, numactions = Array.sum strategySum, strategySum.Length           
  if  nSum <= 0. then 
       Array.create numactions (1./float numactions) 
  else Array.map (fun x -> x/nSum) strategySum   

let getAction (actions:_[]) strategy = actions.[discreteSample strategy]

//============================

let train1 iters f actions actionDistr regretSum strategySum =
    for _ in 0..iters - 1 do
        let strategy = getStrategy strategySum regretSum
            
        let otheraction = getAction actions actionDistr
        let heroaction  = getAction actions strategy

        let heroutil,_ = f (heroaction,otheraction)

        Array.iteri (fun a action ->  
              let altutil, _ = f (action,otheraction)              
              regretSum.[a] <- regretSum.[a] + (altutil - heroutil)) actions
     

let train iters f actions regretSum regretSum2 strategySum strategySum2 =
    for _ in 0..iters - 1 do
        let strategy  = getStrategy strategySum regretSum
        let strategy2 = getStrategy strategySum2 regretSum2
    
        let otheraction = getAction actions strategy2
        let heroaction  = getAction actions strategy

        let heroutil,otherutil = f (heroaction,otheraction)

        Array.iteri (fun a action ->  
              let altutil , _ = f (action,otheraction)
              let altutil2, _ = f (action,heroaction)

              regretSum.[a]  <- regretSum.[a]  + (altutil - heroutil)
              regretSum2.[a] <- regretSum2.[a] + (altutil2 - otherutil)) actions

//===========================================

let inline displayTable2 tostring title roundTableTo roundProbTo keepZeroes winner strat1 strat2 = 
    let buildTable player =
        [|for (move,p) in strat1 do
           for (move2,p2) in strat2 ->
               [|tostring move; tostring move2; string (round roundTableTo p) ; 
                 string (round roundTableTo p2); string (round roundTableTo (p * p2)); ""; ""|] , 
               (player (winner (move,move2)) * (p * p2) , 
                player (winner (move2,move)) * (p * p2))|]

    let table = buildTable fst    
    let tabledisp =    Array.filter (fun (_,(p,_))   -> keepZeroes || round roundProbTo p <> 0.) table 
                    |> Array.map    (fun (row,(u,u2)) -> row.[row.Length - 2] <- string (round roundTableTo u)
                                                         row.[row.Length - 1] <- string (round roundTableTo u2); row)   
                                                     
    let astable = makeTable "\n" [|"Player 1";"Player 2";"Prob 1";"Prob 2";"Joint Prob";"Player 1 Util";"Player 2 Util"|] title tabledisp
    
    printfn "\n%s\n\nPlayer1: %A | Player2 : %A" 
             astable (Array.sumBy (snd >> fst) (table) |> round roundProbTo) 
                     (Array.sumBy (snd >> snd) (table) |> round roundProbTo)


let inline displayTable tostring title winner strat1 strat2 = displayTable2 tostring title 3 2 false winner strat1 strat2 


let inline printStrategy2 tostring title n strat = 
      let rows = Array.map (fun (move,p) -> [|tostring move; string(round n p)|]) strat      
      let astable = makeTable "\n" [|"Move";"Move Probability"|] title rows      
      
      printfn "\n%s" astable

let inline printStrategy tostring title strat = printStrategy2 tostring title 3 strat 

let simulatePlay dodisp rounds bet winner strat1 strat2 =
    let results = 
        [|for _ in 0..rounds - 1 ->
              let move1 = strat1 |> Array.unzip ||> getAction  
              let move2 = strat2 |> Array.unzip ||> getAction 
    
              let res1, res2 = winner (move1, move2)
              res1 * bet, res2 * bet|]

    let p1win,p2win = Array.fold (pairop (+)) (0.,0.) results
    if dodisp then printfn "Player1 wins: %A | Player2 wins: %A" p1win p2win
    p1win,p2win
    

/////////////////////////////START/              

let reset (a:_[]) = for i in 0..a.Length - 1 do a.[i] <- 0.   

type Moves2 = R | P | S | T

let move2String = function R -> "rock" | P -> "paper" | S -> "scissors" | T -> "telephone"

//The numbers control the utilities for the game. Ensure left and right sum to 0.
let winner2 =
    function 
      | (R,R) -> ( 0.,0. )
      | (P,R) -> ( 1.,-1.) 
      | (S,R) -> (-1.,1. )
    
      | (T,R) -> (1.,-1. )
    
      | (R,P) -> (-1.,1. )
      | (P,P) -> ( 0.,0. )
      | (S,P) -> ( 1.,-1.)
      
      | (T,P) -> ( 1.,-1.)
      
      | (R,S) -> ( 1.,-1.)
      | (P,S) -> (-1.,1. )
      | (S,S) -> ( 0.,0. ) 
    
      | (T,S) -> ( -1.,1.) 
     
      | (R,T) -> (-1.,1. )
      | (P,T) -> (-1.,1. )
      | (S,T) -> (1.,-1. )
      | (T,T) -> (0.,0.  )

//The numbers control the utilities for the game. Ensure left and right sum to 0.
let winner3 =
    function 
      | (R,R) -> ( 0.,0. )
      | (P,R) -> ( 1.,-1.) 
      | (S,R) -> (-1.,1. )
                    //This essentially flips a coin but can change the number to <= 1.
      | (T,R) -> if random.NextDouble() < 0.5 then (1.,-1. ) else (-1.,1. )
    
      | (R,P) -> (-1.,1. )
      | (P,P) -> ( 0.,0. )
      | (S,P) -> ( 1.,-1.)
                 //roll a die with sides 4 or less as wins.
      | (T,P) -> if random.NextDouble() < 4./6. then (1.,-1. ) else (-1.,1. )
      
      | (R,S) -> ( 1.,-1.)
      | (P,S) -> (-1.,1. )
      | (S,S) -> ( 0.,0. ) 
    
      | (T,S) -> (-1.,1.)
     
      | (R,T) -> if random.NextDouble() < 0.5 then (-1.,1. ) else (1.,-1. )
      | (P,T) -> if random.NextDouble() < 4./6. then (-1.,1. ) else (1.,-1. )
      | (S,T) -> (1.,-1.)
      | (T,T) -> (0.,0. )
//---------------------------

let regretSumX   = [|0.;0.;0.;0.|]
let strategySumX = [|0.;0.;0.;0.|]

let regretSum2X   = [|0.;0.;0.;0.|]
let strategySum2X = [|0.;0.;0.;0.|]
    
let rpstStratDef  = Array.zip [|R;P;S;T|] [|0.4;0.4;0.1;0.1|] //<== These numbers can be changed. Ensure sums to 1.
let rpstStratDef2 = Array.zip [|R;P;S;T|] [|0.3;0.2;0.1;0.4|] //<== These numbers can be changed. Ensure sums to 1. 
let purePaper     = Array.zip [|R;P;S;T|] [|0.;1.;0.;0.|]   
let pureRock      = Array.zip [|R;P;S;T|] [|1.;0.;0.;0.|]   
let pureTelephone = Array.zip [|R;P;S;T|] [|0.;0.;0.;1.|]   

let winnerFunction = winner3 //<== Change the name of this function to either *winner2* or *winner3* to control what is learnt

train1 200000 winnerFunction [|R;P;S;T|] (Array.map snd rpstStratDef) regretSumX strategySumX 

let rpstStrat1 = Array.zip [|R;P;S;T|] (getAvgStrategy strategySumX)   
printStrategy move2String "Learned Strategy" rpstStrat1     

displayTable move2String "Learned Strategy vs Fixed Adversary" winnerFunction rpstStrat1 rpstStratDef //note that displayTable probabilities and expected values aren't quite correct for winner3 

let avg = [|for _ in 0..99 -> simulatePlay false 10 5. winnerFunction rpstStrat1 rpstStratDef|] |> Array.averageBy fst    

printfn "\n~Strategy EV (10 rounds, $5/round)\n [paper,100%%] vs [rock, 40%%; paper, 40%%; scissors, 10%%; telephone, 10%%] = %A" avg

//---------------------------

reset regretSumX; reset strategySumX                  
train 200000 winnerFunction [|R;P;S;T|] regretSumX regretSum2X strategySumX strategySum2X

let rpstStrat1b, rpstStrat2 = 
    Array.zip [|R;P;S;T|] (getAvgStrategy strategySumX) ,
    Array.zip [|R;P;S;T|] (getAvgStrategy strategySum2X) 

printStrategy move2String "Equil1" rpstStrat1b
printStrategy move2String "Equil2" rpstStrat2

displayTable move2String "Equil" winnerFunction rpstStrat1b rpstStrat2

displayTable move2String "equil1 vs adv" winnerFunction rpstStrat1b rpstStratDef2 
displayTable move2String "rock vs equil2"  winnerFunction pureRock rpstStrat2