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 = ``Do π`` | ``Do π``
type Decision = ``Do π`` of float [] | ``Do π¦``
let moves = [|``Do π``;``Do π``|]
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 ``Do π``,``Do π`` else ``Do π``,``Do π``
let randomLight () = if random.NextDouble() < 0.5 then ``Do π`` else ``Do π``
let faultyLight p2 p = if random.NextDouble() < p then randomLight(),randomLight() else sampleLight p2
//============
let drive =
function
| (``Do π``,``Do π``) -> (0.,0.)
| (``Do π``,``Do π``) -> (0.,1.)
| (``Do π``,``Do π``) -> (1.,0.)
| (``Do π``,``Do π``) -> (-100.,-100.)
let getExpert signal (actions:_[]) (experts:_[]) =
let e = discreteSample (Array.map fst experts)
match experts.[e] with
| (_,``Do π`` 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 _, (``Do π`` wi) = weights.[1]
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 π`` wi)
let learner failrate =
let heroweights = [|0.5, ``Do π¦``; 1./2., ``Do π`` (Array.create 2 1. |> Array.normalize)|]
let otherweight = [|0.5, ``Do π¦``; 1./2., ``Do π`` (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 [|``Do π``;``Do π``|] heroweights
let p2mov = getExpert light2 [|``Do π``;``Do π``|] 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 "π¦: %A%%" (round100 p)
| (p,``Do π`` a) -> printfn "π: %A%% %A" (round100 p) (Array.map (round 2) a |> Array.zip moves))
print heroweights , print otherweight
learner 0.001