fork download
copy 
  1. open System
  2.  
  3. let random = new Random()                                     
  4.  
  5. let flip f a b = f b a
  6.  
  7. let scaleTo rmin rmax rangemin rangemax value =
  8.    let adjrmin, adjrmax, adjval = 
  9.        if rangemin < 0. then 0., -rangemin + rangemax , -rangemin + value 
  10.        else rangemin, rangemax , value //translate to 0
  11.  
  12.    (adjval - adjrmin)/(adjrmax - adjrmin) * (rmax-rmin) + rmin
  13.  
  14. module Array =
  15.   let inline normalize (a: _[]) = 
  16.       let tot = Array.sum a
  17.       Array.map (flip (/) tot) a           
  18.  
  19.  
  20. let cdf p = 
  21.     p |> Array.fold (fun (total, list) v -> 
  22.                 let cd = v + total
  23.                 cd, cd::list) (0., []) 
  24.       |> snd 
  25.       |> Array.ofList 
  26.  
  27. let getDiscreteSampleFromCDF (pcdf:float[]) = 
  28.     let k, pcdlen = random.NextDouble() * pcdf.[0], pcdf.Length - 1
  29.  
  30.     let rec cummProb idx = if k > pcdf.[idx] then cummProb (idx - 1) else idx
  31.  
  32.     abs(cummProb pcdlen - pcdlen) 
  33.  
  34. let discreteSample p = cdf p |> getDiscreteSampleFromCDF  
  35.  
  36. let round (n:int) (x:float) = Math.Round(x,n)                                                                               
  37.  
  38. //////////////////////////////   
  39.  
  40. type Go = ``Do 🛑`` | ``Do 🚙``
  41.  
  42. type Decision = ``Do 😏`` of float [] | ``Do 🚦``    
  43.  
  44. let moves = [|``Do 🛑``;``Do 🚙``|]
  45.  
  46. let multiplicativeWeightsUpdate rate minAmount maxAmount (oldweights:float []) (results:seq<float>) =      
  47.     let lossbounded = scaleTo -1. 1. minAmount maxAmount 
  48.     results |> Seq.mapi (fun i r -> oldweights.[i] * (1. + rate * lossbounded (min r maxAmount)))
  49.             |> Seq.toArray 
  50.             |> Array.normalize
  51.  
  52. let learningExpert2 prevWeights rate res = multiplicativeWeightsUpdate rate -100. 1. prevWeights res
  53.  
  54. let sampleLight p = if random.NextDouble() < p then ``Do 🛑``,``Do 🚙`` else ``Do 🚙``,``Do 🛑``
  55.  
  56. let randomLight () = if random.NextDouble() < 0.5 then ``Do 🛑`` else ``Do 🚙``
  57.  
  58. let faultyLight p2 p = if random.NextDouble() < p then randomLight(),randomLight() else sampleLight p2
  59.  
  60. //============
  61.  
  62. let drive =
  63.     function 
  64.       | (``Do 🛑``,``Do 🛑``) -> (0.,0.)
  65.       | (``Do 🛑``,``Do 🚙``)   -> (0.,1.) 
  66.       | (``Do 🚙``,``Do 🛑``)   -> (1.,0.)
  67.       | (``Do 🚙``,``Do 🚙``)   -> (-100.,-100.)
  68.  
  69. let getExpert signal (actions:_[]) (experts:_[]) = 
  70.     let e = discreteSample (Array.map fst experts)
  71.     match experts.[e] with
  72.      | (_,``Do 😏`` es) -> actions.[discreteSample es]
  73.      | (_,``Do 🚦``)     -> signal
  74.  
  75.  
  76. let learnExperts2 signal rate selfmove opmove (weights:_[]) =    
  77.     let w0 = Array.map fst weights
  78.  
  79.     let cost = [|fst(drive (signal,opmove)); fst(drive (selfmove,opmove))|]
  80.  
  81.     let costinner = Array.init moves.Length (fun m -> w0.[1] * fst(drive (moves.[m],opmove)))       
  82.     let _, (``Do 😏`` wi) = weights.[1]
  83.  
  84.     Array.Copy(learningExpert2 w0 rate cost,w0,w0.Length)
  85.     Array.Copy(learningExpert2 wi rate costinner,wi,wi.Length)
  86.  
  87.     weights.[0] <- w0.[0], snd weights.[0]
  88.     weights.[1] <- w0.[1], (``Do 😏`` wi)
  89.  
  90. let learner failrate =
  91.     let heroweights = [|0.5, ``Do 🚦``; 1./2., ``Do 😏`` (Array.create 2 1. |> Array.normalize)|]
  92.     let otherweight = [|0.5, ``Do 🚦``; 1./2., ``Do 😏`` (Array.create 2 1. |> Array.normalize)|]
  93.  
  94.     let rate = 0.5
  95.  
  96.     for _ in 0..99999 do
  97.         let light1, light2 = faultyLight 0.5 failrate// <== CHANGEABLE sampleLight 0.9 //sampleLight 0.5
  98.  
  99.         let p1mov = getExpert light1 [|``Do 🛑``;``Do 🚙``|] heroweights
  100.         let p2mov = getExpert light2 [|``Do 🛑``;``Do 🚙``|] otherweight
  101.  
  102.         learnExperts2 light1 rate p1mov p2mov heroweights
  103.         learnExperts2 light2 rate p2mov p1mov otherweight
  104.  
  105.     let round100 x = round 2 (x*100.)
  106.  
  107.     let print a = a |> Array.iter (function 
  108.                        | (p,``Do 🚦``) -> printfn "🚦: %A%%" (round100 p)  
  109.                        | (p,``Do 😏`` a) -> printfn "😏: %A%% %A" (round100 p) (Array.map (round 2) a |> Array.zip moves))
  110.  
  111.     print heroweights , print otherweight                                         
  112.  
  113. learner 0.001
  114.  
  115.  
Success #stdin #stdout 0.29s 134720KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
🚦: 99.66%
😏: 0.34% [|(Do 🛑, 1.0); (Do 🚙, 0.0)|]
🚦: 99.68%
😏: 0.32% [|(Do 🛑, 1.0); (Do 🚙, 0.0)|]
https://ideone.com/qUXG27
language:
F# (mono 4.1)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!