loading
open in
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
open System
 
let random = new Random()                                     
 
let flip f a b = f b a
 
let keepLeft f (x,y) = x, f y
 
let keepRight f (x,y) = f x, y
 
let fst3 (a,_,_) = a
 
let fst_snd3 (a,b,_) = a,b
 
let scaleTo rmin rmax rangemin rangemax value =
   let adjrmin, adjrmax, adjval = 
       if rangemin < 0. then 0., -rangemin + rangemax , -rangemin + value 
       else rangemin, rangemax , value //translate to 0
 
   (adjval - adjrmin)/(adjrmax - adjrmin) * (rmax-rmin) + rmin
 
module Array =
  let inline normalize (a: _[]) = 
      let tot = Array.sum a
      Array.map (flip (/) tot) a           
 
  let inline normalizeWeights (a: ('a * 'b) []) = 
      let tot = Array.sumBy snd a
      Array.map (keepLeft (flip (/) tot)) a
 
 
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 round (n:int) (x:float) = Math.Round(x,n)                                                                               
 
 
//////////////////////////////   
 
type Go = STOP | DRIVE
 
type Decision = ``Do 😏`` of float [] | ``Do 🚦``    
 
let moves = [|STOP;DRIVE|]
 
let multiplicativeWeightsUpdate rate minAmount maxAmount (oldweights:float []) (results:seq<float>) =      
    let lossbounded = scaleTo -1. 1. minAmount maxAmount 
    results |> Seq.mapi (fun i r -> oldweights.[i] * (1. + rate * lossbounded (min r maxAmount)))
            |> Seq.toArray 
            |> Array.normalize
 
let learningExpert2 prevWeights rate res = multiplicativeWeightsUpdate rate -100. 1. prevWeights res
 
let sampleLight p = if random.NextDouble() < p then STOP,DRIVE else DRIVE,STOP
 
let randomLight () = if random.NextDouble() < 0.5 then STOP else DRIVE
let faultyLight p2 p = if random.NextDouble() < p then randomLight(),randomLight() else sampleLight p2
 
 
//============
 
let drive =
    function 
      | (STOP,STOP) -> (0.,0.)
      | (STOP,DRIVE)   -> (0.,1.) 
      | (DRIVE,STOP)   -> (1.,0.)
      | (DRIVE,DRIVE)   -> (-100.,-100.)
 
let inline getExpertVerbose indicated signal (rules:_[]) = 
    printfn "Signal = %A" signal
    let other = match indicated with None -> "N/A" | Some a -> string a
    printfn "Other signal: %s" other
 
    let cs = [|for (p,r,f) in rules do 
               match f indicated signal with
                 | Some e -> printfn "Rule %s with weight %A matched" r p; yield e, p 
                 | None -> ()|] 
              |> Array.normalizeWeights 
 
    printfn "Normalized %A" cs
    let cs' = Array.groupBy fst cs |> Array.map (fun (s,c) -> s, Array.sumBy snd c)
    printfn "%A" cs'
    let ps = Array.map snd cs
 
    fst (cs.[discreteSample ps])
 
let inline getExpert2 indicated signal (rules:_[]) = 
    let cs = [|for (p,_,f) in rules do 
               match f indicated signal with 
                | Some c -> yield c,p 
                | None -> ()|] |> Array.normalizeWeights
    let ps = Array.map snd cs
    fst(cs.[discreteSample ps])
 
 
let learnExperts3 signal rate opmove (rules:_[]) =
    let costs = 
        [|for (p,_,f) in rules do 
            match f (Some opmove) signal with //<== change (Some opmove) to (None), see what happens
              | Some choice -> yield (p * fst(drive (choice,opmove))) 
              | None -> yield 0.|]
 
    let w = Array.map fst3 rules
 
    Array.Copy(learningExpert2 w rate costs,w,w.Length)   
 
    for i in 0..w.Length - 1 do
      let _,name,f = rules.[i]
      rules.[i] <- w.[i],name,f
 
 
let learnExpertsVerbose signal rate opmove (rules:_[]) =
    let costs = [|for (p,hh,f) in rules do 
                    match f (Some opmove) signal with 
                     | Some choice -> 
                      printfn "%A" ((p ,hh,opmove,choice, fst(drive (choice,opmove))) )
                      yield (p * fst(drive (choice,opmove))) 
                     | None -> yield 0.|]
    let w = Array.map fst3 rules
    Array.Copy(learningExpert2 w rate costs,w,w.Length)   
    for i in 0..w.Length - 1 do
      let _,name,f = rules.[i]
      rules.[i] <- w.[i],name,f
 
 
let rules =   
    let num_moves = (float moves.Length)*(float moves.Length)*(float moves.Length)
    [|for m in moves do
      for m2 in moves do
      for m3 in moves ->
        let rulename = sprintf "if signal=%A && other=%A then %A" m m2 m3
 
        1./num_moves, 
        rulename, 
        fun other signal -> 
        match other with
         | None -> if signal = m then Some m3 else None
         | Some indicated -> if signal = m && indicated = m2 then Some m3 else None|]
 
 
let gatherStats n look1 look2 otherweight heroweights = 
    let lists = ResizeArray()
    for i in 0..n do
      let light1, light2 = sampleLight 0.5  
      let p1mov = getExpert2 (if look1 then Some light2 else None) light1 heroweights
      let p2mov = getExpert2 (if look2 then Some p1mov else None) light2 otherweight
      lists.Add(p1mov,p2mov)
    lists
 
let round100 x = sprintf "%A%%" (round 2 ((float x)*100.))
 
let learner2 () =
    let mutable heroweights = Array.map id rules
    let mutable otherweight = Array.map id rules
 
    let rate = 0.5
 
    for _ in 0..99999 do
        let light1, light2 = sampleLight 0.5   
 
        let p1mov = getExpert2 (Some light2) light1 heroweights // <== Change (Some light2) to None 
        let p2mov = getExpert2 (Some p1mov) light2 otherweight
        learnExperts3 light1 rate p2mov heroweights
        learnExperts3 light2 rate p1mov otherweight        
 
    let gathered = gatherStats 999 true true otherweight heroweights
 
    gathered.ToArray() 
    |> Array.groupBy id    
    |> Array.map (keepLeft (Array.length >> float))
    |> Array.normalizeWeights 
    |> Array.map (keepLeft round100)
    |> printfn "%A\n"
 
    printfn "Rules 1: %A" (Array.map fst_snd3 heroweights |> Array.filter (fst >> round 2 >> (<>) 0.) |> Array.map (keepRight round100))
    printfn "Rules 2: %A" (Array.map fst_snd3 otherweight |> Array.filter (fst >> round 2 >> (<>) 0.) |> Array.map (keepRight round100))
 
learner2()