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
open System
 
let random = new Random()   

let flip f a b = f b a

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 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_As_I_Please 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 getExpert signal (actions:_[]) (experts:_[]) = 
    let e = discreteSample (Array.map fst experts)
    match experts.[e] with
     | (_,Do_As_I_Please es) -> actions.[discreteSample es]
     | (_,``Do 🚦``)     -> signal
 
 
let learnExperts2 signal rate selfmove opmove (weights:_[]) =    
    let w0 = Array.map fst weights
 
    let cost = [|fst(drive (signal,opmove)); fst(drive (selfmove,opmove))|]
 
    let costinner = Array.init moves.Length (fun m -> w0.[1] * fst(drive (moves.[m],opmove)))       
    let wi = match weights.[1] with (_, Do_As_I_Please wi) -> wi | _ -> Array.empty
 
    Array.Copy(learningExpert2 w0 rate cost,w0,w0.Length)
    Array.Copy(learningExpert2 wi rate costinner,wi,wi.Length)
 
    weights.[0] <- w0.[0], snd weights.[0]
    weights.[1] <- w0.[1], (Do_As_I_Please wi)
 
let learner failrate =
    let heroweights = [|0.5, ``Do 🚦``; 1./2., Do_As_I_Please (Array.create 2 1. |> Array.normalize)|]
    let otherweight = [|0.5, ``Do 🚦``; 1./2., Do_As_I_Please (Array.create 2 1. |> Array.normalize)|]
 
    let rate = 0.5
 
    for _ in 0..99999 do
        let light1, light2 = faultyLight 0.5 failrate// <== CHANGEABLE sampleLight 0.9 //sampleLight 0.5
 
        let p1mov = getExpert light1 [|STOP;DRIVE|] heroweights
        let p2mov = getExpert light2 [|STOP;DRIVE|] otherweight
 
        learnExperts2 light1 rate p1mov p2mov heroweights
        learnExperts2 light2 rate p2mov p1mov otherweight
 
    let round100 x = round 2 (x*100.)
 
    let print a = a |> Array.iter (function 
                       | (p,``Do 🚦``) -> printfn "Follow Lights: %A%%" (round100 p)  
                       | (p,Do_As_I_Please a) -> printfn "Do As I Please: %A%% %A" (round100 p) (Array.map (round 2) a |> Array.zip moves))
 
    print heroweights , print otherweight                                         
 
learner 0.001 |> ignore