#r "../PopDEVS/bin/Debug/netstandard2.0/PopDEVS.dll"
open PopDEVS

#load "XPlot.Plotly.Paket.fsx"
#load "XPlot.Plotly.fsx"
open XPlot.Plotly

type TrafficLightColor =
    | Green
    | Yellow
    | Red
    | Black

type PolicemanInstruction =
    | ToManual
    | ToAuto

module TrafficLightModel =
    type AutoColor =
        | Green
        | Yellow
        | Red

    let timeAdvanceByColor = function
        | AutoColor.Green -> 50.0
        | AutoColor.Yellow -> 10.0
        | AutoColor.Red -> 60.0

    type State =
        | Auto of color: AutoColor * elapsed: float
        | Manual
        | ToManual
        | ToAuto
        
    let create initialState =
        let transition (state, elapsed, inputBag: InputEventBag<PolicemanInstruction>) =
            let state =
                if elapsed.Completed then
                    // 通常の状態遷移
                    match state with
                    | Auto (Green, _) -> Auto (Yellow, 0.0)
                    | Auto (Yellow, _) | ToAuto -> Auto (Red, 0.0)
                    | Auto (Red, _) -> Auto (Green, 0.0)
                    | Manual | ToManual -> Manual
                else
                    // elapsed を進める
                    match state with
                    | Auto (color, e) -> Auto (color, e + elapsed.Elapsed)
                    | x -> x
            
            // 入力イベントの処理
            match (Seq.tryHead inputBag.Events, state) with
            | (Some PolicemanInstruction.ToManual, Manual) -> Manual
            | (Some PolicemanInstruction.ToManual, _) -> ToManual
            | (Some PolicemanInstruction.ToAuto, Auto _) -> state
            | (Some PolicemanInstruction.ToAuto, _) -> ToAuto
            | (None, _) -> state
            
        let timeAdvance = function
            | Auto (color, e) -> (timeAdvanceByColor color) - e
            | Manual -> infinity
            | ToManual | ToAuto -> 0.0
            
        let output state =
            match state with
                | Auto (Green, _) -> [ TrafficLightColor.Yellow ]
                | Auto (Yellow, _) -> [ TrafficLightColor.Red ]
                | Auto (Red, _) -> [ TrafficLightColor.Green ]
                | ToManual -> [ TrafficLightColor.Black ]
                | ToAuto -> [ TrafficLightColor.Red ]
                | Manual -> []
            |> Seq.ofList
            
        AtomicModel.create (transition, timeAdvance, output) initialState
        |> AtomicModel.withName "TrafficLight"

module PolicemanModel =
    type State =
        | Idle
        | Working
        
    let create initialState : AtomicModel<VoidEvent, _> =
        let transition (state, _, _) =
            match state with
            | Idle -> Working
            | Working -> Idle
            
        let timeAdvance = function
            | Idle -> 200.0
            | Working -> 100.0
            
        let output state =
            let outputValue =
                match state with
                | Idle -> ToManual
                | Working -> ToAuto
            [ outputValue ] |> Seq.ofList
            
        AtomicModel.create (transition, timeAdvance, output) initialState
        |> AtomicModel.withName "Policeman"

open System.Collections.Generic

let simulate (trafficLightState, policemanState) maxTime =
    let systemBuilder = CoupledModelBuilder<VoidEvent, VoidEvent>()
    let trafficLightRef = systemBuilder.AddComponent(TrafficLightModel.create trafficLightState)
    let policemanRef = systemBuilder.AddComponent(PolicemanModel.create policemanState)
    
    systemBuilder.Connect(policemanRef, trafficLightRef, Some)
    
    // コンソールに表示
    let printObserver (ev: EventObserver.ObservedEvent<obj>) =
        printfn "[%f] %s: %O" ev.Time (Option.get ev.Model.Name) ev.Event
    EventObserver.observeAll printObserver systemBuilder |> ignore
    
    // 信号機モデルの出力
    let trafficLightObservations = List()
    // 初期状態を追加
    match trafficLightState with
        | TrafficLightModel.Auto (TrafficLightModel.Green, _) -> Some (0.0, Green)
        | TrafficLightModel.Auto (TrafficLightModel.Yellow, _) -> Some (0.0, Yellow)
        | TrafficLightModel.Auto (TrafficLightModel.Red, _) -> Some (0.0, Red)
        | TrafficLightModel.Manual -> Some (0.0, Black)
        | _ -> None
    |> Option.iter trafficLightObservations.Add
    
    let trafficLightObserver (ev: EventObserver.ObservedEvent<TrafficLightColor>) =
        trafficLightObservations.Add((ev.Time, ev.Event))
    EventObserver.observe trafficLightObserver systemBuilder trafficLightRef |> ignore
    
    // 警察官の出力
    let policemanObservations = List()
    let policemanObserver (ev: EventObserver.ObservedEvent<PolicemanInstruction>) =
        policemanObservations.Add((ev.Time, ev.Event))
    EventObserver.observe policemanObserver systemBuilder policemanRef |> ignore
    
    let runner = SequentialRunner.Create(systemBuilder.Build())
    runner.RunUntil(maxTime)
    
    (trafficLightObservations :> IReadOnlyList<_>, policemanObservations :> IReadOnlyList<_>)

let initialState = (
    TrafficLightModel.Auto (TrafficLightModel.Green, 0.0),
    PolicemanModel.Idle)

let (trafficLightObservations, policemanObservations) =
    simulate initialState 400.0

[50.000000] TrafficLight: Yellow
[60.000000] TrafficLight: Red
[120.000000] TrafficLight: Green
[170.000000] TrafficLight: Yellow
[180.000000] TrafficLight: Red
[200.000000] Policeman: ToManual
[200.000000] TrafficLight: Black
[300.000000] Policeman: ToAuto
[300.000000] TrafficLight: Red
[360.000000] TrafficLight: Green

let colorToNum = function
    | Green -> 3
    | Yellow -> 4
    | Red -> 5
    | Black -> 6

let instToNum = function
    | ToManual -> 1
    | ToAuto -> 2
    
let colorTrace =
    Scatter(
        name = "TrafficLight",
        x = (trafficLightObservations |> Seq.map (fun (time, _) -> time)),
        y = (trafficLightObservations |> Seq.map (fun (_, color) -> colorToNum color)),
        mode = "lines+markers",
        line = Line(shape = "hv"))

let instColor = "#ff7f0e"
let instTrace =
    Scatter(
        name = "Policeman",
        x = (policemanObservations |> Seq.map (fun (time, _) -> time)),
        y = (policemanObservations |> Seq.map (fun (_, inst) -> instToNum inst)),
        mode = "markers",
        marker = Marker(color = instColor))

let layout =
    let instToVerticalLine (time, inst) =
        let x, y = time, instToNum inst
        Shape(
            ``type`` = "line",
            x0 = x, y0 = 0,
            x1 = x, y1 = y,
            line = Line(color = instColor))
    Layout(
        yaxis = Yaxis(
            tickmode = "array",
            tickvals = seq { 1 .. 6 },
            ticktext = [| "ToManual"; "ToAuto"; "Green"; "Yellow"; "Red"; "Black" |],
            range = [| 0, 6 |]),
        shapes = (policemanObservations |> Seq.map instToVerticalLine))

[ colorTrace; instTrace ]
|> Chart.Plot
|> Chart.WithLayout layout

参考文献¶