gen_pnet

%% -*- erlang -*-
%%
%% A generic Petri net OTP behavior.
%%
%% Copyright 2016-2017 Jorgen Brandt
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% -------------------------------------------------------------------
%% @author Jorgen Brandt <joergen.brandt@onlinehome.de>
%% @version 0.1.2
%% @copyright 2016-2017 Jorgen Brandt
%% @see gen_pnet_iface
%% @see gen_pnet_struct
%% @doc Callback function definitions and API for the `gen_pnet' behavior.
%%
%% The callbacks defined for the `gen_pnet' behavior may be separated into a
%% Petri net structure part and an actor interface part. Both behaviors are
%% documented in the `gen_pnet_struct' and `gen_pnet_iface' modules
%% respectively.
%%
%% @end
%% -------------------------------------------------------------------

-module( gen_pnet ).

-behaviour( gen_server ).

% API functions
-export( [new/2, start_link/2, start_link/3, ls/2, marking/1, call/2, cast/2,
          get_stats/1, reset_stats/1, stop/1] ).

% gen_server callbacks
-export( [code_change/3, handle_call/3, handle_cast/2, handle_info/2,
          init/1, terminate/2] ).

% Helper functions
-export( [ls_place/2] ).

-include( "gen_pnet.hrl" ).

%%====================================================================
%% Callback definitions
%%====================================================================

%% Interface callbacks

-callback code_change( OldVsn :: _, NetState :: #net_state{}, Extra :: _ ) ->
            {ok, #net_state{}} | {error, _}.

-callback handle_call( Request :: _, From :: {pid(), _},
                       NetState :: #net_state{} ) ->
            {reply, _} | {reply, _, #{ atom() => [_] }, #{ atom() => [_] }}.

-callback handle_cast( Request :: _, NetState :: #net_state{} ) ->
            noreply | {noreply, #{ atom() => [_] }, #{ atom() => [_] }}.

-callback handle_info( Info :: _, NetState :: #net_state{} ) ->
            noreply | {noreply, #{ atom() => [_] }, #{ atom() => [_] }}.

-callback terminate( Reason :: _, NetState :: #net_state{} ) -> ok.

-callback trigger( Place :: atom(), Token :: _ ) -> pass | drop.


%% Structure callbacks

-callback place_lst() -> [atom()].

-callback trsn_lst() -> [atom()].

-callback init_marking( atom() ) -> [_].

-callback preset( Place :: atom() ) -> [atom()].

-callback is_enabled( Trsn :: atom(), Mode :: #{ atom() => [_]} ) -> boolean().

-callback fire( Trsn :: atom(), Mode :: #{ atom() => [_] } ) ->
            abort | {produce, #{ atom() => [_] }}.

%%====================================================================
%% API functions
%%====================================================================

%% @doc Generates an initial instance of a state record.
%%
%%      Such a state record can be used to initialize a `gen_pnet' instance with
%%      `start_link/1' or `start_link/2'.
%%
%% @see start_link/2
%% @see start_link/3
new( NetMod, IfaceMod ) ->
  #net_state{ net_mod = NetMod, iface_mod = IfaceMod }.

%% @doc Starts an unregistered net instance.
%%
%%      The `gen_pnet' instance can be initialized with either the callback
%%      module name `Mod', implementing all callback functions or with a
%%      `#net_state{}' record instance. Such a `#net_state{}' record can be
%%      generated using the `new/3' function. The option list `Options' is
%%      handed down to `gen_server:start_link/3' as is.
%%
%% @see new/3
start_link( Mod, Options ) when is_atom( Mod ) ->
  start_link( #net_state{ iface_mod = Mod, net_mod = Mod }, Options );

start_link( NetState = #net_state{}, Options ) ->
  gen_server:start_link( ?MODULE, NetState, Options ).

%% @doc Starts a net instance registered to `ServerName' using the callback
%%      module `Mod' or a `#net_state' record instance which can be created
%%      using `new/3'. Herein, the `ServerName' argument can be
%%      `{local, Name} | {global, Name} | {via, Module, ViaName}'. The server
%%      name `ServerName' and option list `Options' are handed down to
%%      `gen_server:start_link/4' as is.
%%
%% @see new/3
start_link( ServerName, Mod, Options ) when is_atom( Mod ) ->
  NetState = #net_state{ iface_mod = Mod, net_mod = Mod },
  start_link( ServerName, NetState, Options );

start_link( ServerName, NetState = #net_state{}, Options ) ->
  gen_server:start_link( ServerName, ?MODULE, NetState, Options ).

%% @doc Requests the net instance under process id `Pid' to list all
%%      tokens on the place named `Place'.
%%
%%      Herein, `Pid' can also be a registered process name. The return value is
%%      either `{ok, [_]}'' if the place exists or a `{error, #bad_place{}}'
%%      tuple.
ls( Pid, Place ) ->
  gen_server:call( Pid, {ls, Place} ).

%% @doc Requests the net instance under process id `Pid' to return a
%%      marking map, associating to each place name the list of tokens that this
%%      place holds.
%%
%%      Herein, `Pid' can also be a registered process name. The return value is
%%      just the plain map.
marking( Pid ) ->
  gen_server:call( Pid, marking ).

%% @doc Requests the net instance under process id `Pid' to return the
%%      throughput of the net.
%%
%%      The throughput is given as a `#stats{}' record consisting of three
%%      `#stat{}' record instances characterizing the current, maximum, and
%%      minimum throughput of this net in transition firings per second.
get_stats( Pid ) ->
  gen_server:call( Pid, get_stats ).

%% @doc Requests the net instance under process id `Pid' to clear its stats.
reset_stats( Pid ) ->
  gen_server:call( Pid, reset_stats ).

%% @doc Signal the net instance under process id `Pid' to stop.
stop( Pid ) ->
  gen_server:stop( Pid ).

%% @doc Send the request term `Request' to the net instance under process id
%%      `Pid' and return the reply.
%%
%%      The request is handled by the `handle_call/3' callback function of the
%%      interface module.
call( Pid, Request ) ->
  gen_server:call( Pid, {call, Request} ).

%% @doc Send the request term `Request' asynchronously to the net instance under
%%      process id `Pid'.
%%
%%      The request is handled by the `handle_cast/2' callback function of the
%%      interface module. Note that the cast succeeds even if a non-existing
%%      process is addressed or the net instance is down.
cast( Pid, Request ) ->
  gen_server:cast( Pid, {cast, Request} ).


%%====================================================================
%% Generic server callback functions
%%====================================================================

%% @private
code_change( OldVsn, NetState = #net_state{ iface_mod = IfaceMod }, Extra ) ->
  IfaceMod:code_change( OldVsn, NetState, Extra ).


%% @private
handle_call( {ls, Place}, _From, NetState = #net_state{ marking = Marking } ) ->

  Reply = case maps:is_key( Place, Marking ) of
            true  -> {ok, maps:get( Place, Marking )};
            false -> {error, #bad_place{ name = Place }}
          end,

  {reply, Reply, NetState};

handle_call( marking, _From, NetState = #net_state{ marking = Marking } ) ->
  {reply, Marking, NetState};

handle_call( {call, Request}, From,
             NetState = #net_state{ iface_mod = IfaceMod } ) ->

  case IfaceMod:handle_call( Request, From, NetState ) of

    {reply, Reply} ->
      {reply, Reply, NetState};
    
    {reply, Reply, CnsMap, ProdMap} ->
      NetState1 = cns( CnsMap, NetState ),
      produce( self(), ProdMap ),
      {reply, Reply, NetState1}

  end;

handle_call( get_stats, _From, NetState = #net_state{ stats = Stats } ) ->
  {reply, Stats, NetState};

handle_call( reset_stats, _From, NetState ) ->
  {reply, ok, NetState#net_state{ stats = undefined }}.


%% @private
handle_cast( {produce, ProdMap},
             NetState = #net_state{ stats  = Stats,
                                    tstart = T1,
                                    cnt    = Cnt } ) ->
  
  NetState1 = handle_trigger( ProdMap, NetState ),

  case progress( NetState1 ) of

    abort ->
      {noreply, NetState1};

    {delta, Mode, Pm} ->

      NetState2 = cns( Mode, NetState1 ),
      produce( self(), Pm ),

      NetState3 = if
                    Cnt < 1000 -> NetState2#net_state{ cnt = Cnt+1 };
                    true       ->

                      T2 = os:system_time(),
                      Tmean = round( ( T1+T2 )/2 ),
                      Tdelta = T2-T1,
                      CurrentFps = 1000000000000/Tdelta,

                      Current = #stat{ t = Tmean, fps = CurrentFps },

                      {Hi1, Lo1} = case Stats of
                                     undefined -> {Current, Current};
                                     #stats{ hi = H, lo = L } -> {H, L}
                                   end,

                      #stat{ fps = HiFps } = Hi1,
                      #stat{ fps = LoFps } = Lo1,

                      Hi2 = if
                              CurrentFps > HiFps -> Current;
                              true               -> Hi1
                            end,

                      Lo2 = if
                              CurrentFps < LoFps -> Current;
                              true               -> Lo1
                            end,

                      NetState2#net_state{ stats  = #stats{ current = Current,
                                                            hi      = Hi2,
                                                            lo      = Lo2 },
                                           tstart = T2,
                                           cnt    = 0 }
                  end,

      {noreply, NetState3}

  end;

handle_cast( {cast, Request}, NetState = #net_state{ iface_mod = IfaceMod } ) ->

  case IfaceMod:handle_cast( Request, NetState ) of

    noreply ->
      {noreply, NetState};

    {noreply, CnsMap, ProdMap} ->
      NetState1 = cns( CnsMap, NetState ),
      produce( self(), ProdMap ),
      {noreply, NetState1}

  end.


%% @private
handle_info( Info, NetState = #net_state{ iface_mod = IfaceMod } ) ->

  case IfaceMod:handle_info( Info, NetState ) of

    noreply ->
      {noreply, NetState};

    {noreply, CnsMap, ProdMap} ->
      NetState1 = cns( CnsMap, NetState ),
      produce( self(), ProdMap ),
      {noreply, NetState1}

  end.


%% @private
init( NetState = #net_state{ net_mod = NetMod } ) ->

  PlaceLst = NetMod:place_lst(),

  F = fun( P, Acc ) ->
        Acc#{ P => NetMod:init_marking( P ) }
      end,

  InitMarking = lists:foldl( F, #{}, PlaceLst ),

  produce( self(), #{} ),

  {ok, NetState#net_state{ marking = InitMarking,
                           stats   = undefined,
                           tstart  = os:system_time(),
                           cnt     = 0 }}.


%% @private
terminate( Reason, NetState = #net_state{ iface_mod = IfaceMod } ) ->
  IfaceMod:terminate( Reason, NetState ).
  
%%====================================================================
%% Helper functions
%%====================================================================

%% @doc Lists the tokens on a given place from a net state.
%%
%%      Throws an error if the list does not exist.
-spec ls_place( _, #net_state{} ) -> [_].

ls_place( Place, #net_state{ marking = Marking } ) ->
  maps:get( Place, Marking ).


%%====================================================================
%% Internal functions
%%====================================================================

%% @doc Produce the tokens on the places as described in the `ProdMap' argument
%%      atomically in the net instance under process id `Pid'.
%%
%%      Note that production succeeds even if a non-existing process is
%%      addressed or the net instance is down.
produce( Pid, ProdMap ) ->
  gen_server:cast( Pid, {produce, ProdMap} ).


handle_trigger( ProdMap, NetState = #net_state{ iface_mod = IfaceMod } ) ->

  G = fun( P, TkLst, Acc ) ->

        F = fun( Tk, A ) ->
              case IfaceMod:trigger( P, Tk ) of
                pass -> [Tk|A];
                drop -> A
              end
            end,

        TkLst1 = lists:foldl( F, [], TkLst ),
        Acc#{ P => TkLst1 }

      end,

  ProdMap1 = maps:fold( G, #{}, ProdMap ),
  prd( ProdMap1, NetState ).




-spec cns( #{ atom() => [_] }, #net_state{} ) -> _.

cns( Mode, NetState = #net_state{ marking = Marking } ) ->

  F = fun( T, TkLst, Acc ) ->
        Acc#{ T => TkLst--maps:get( T, Mode, [] ) }
      end,

  NetState#net_state{ marking = maps:fold( F, #{}, Marking ) }.

-spec prd( _, #net_state{} ) -> _.

prd( ProdMap, NetState = #net_state{ marking = Marking } ) ->

  F = fun( T, TkLst, Acc ) ->
        Acc#{ T => TkLst++maps:get( T, ProdMap, [] ) }
      end,

  NetState#net_state{ marking = maps:fold( F, #{}, Marking ) }.

-spec progress( #net_state{} ) ->
        abort | {delta, #{ atom() => [_]}, #{ atom() => [_] }}.

progress( #net_state{ marking = Marking, net_mod = NetMod } ) ->

  % get all transitions in the net
  TrsnLst = NetMod:trsn_lst(),

  F = fun( T, Acc ) ->
        Preset = NetMod:preset( T ),
        MLst = enum_mode( Preset, Marking ),
        IsEnabled = fun( M ) -> NetMod:is_enabled( T, M ) end,
        EnabledMLst = lists:filter( IsEnabled, MLst ),
        case EnabledMLst of
          []    -> Acc;
          [_|_] -> Acc#{ T => EnabledMLst }
        end
      end,

  % derive a map listing all enabled modes for each transition
  ModeMap = lists:foldl( F, #{}, TrsnLst ),

  % delegate enabled mode map to attempt_progress function
  attempt_progress( ModeMap, NetMod ).


-spec attempt_progress( map(), atom() ) -> abort | {delta, _, _}.

attempt_progress( ModeMap, NetMod ) ->

  case maps:size( ModeMap ) of

    0 -> abort;
    _ ->

      TrsnLst = maps:keys( ModeMap ),
      Trsn = lib_combin:pick_from( TrsnLst ),
      #{ Trsn := ModeLst } = ModeMap,
      Mode = lib_combin:pick_from( ModeLst ),

      case NetMod:fire( Trsn, Mode ) of

        {produce, ProdMap} ->
          {delta, Mode, ProdMap};
        
        abort ->
          attempt_progress( ModeMap#{ Trsn := ModeLst--Mode }, NetMod )

      end
  end.


-spec enum_mode( [_], _ ) -> _.

enum_mode( Preset, Marking ) ->

  F = fun( P, Acc ) ->
        N = maps:get( P, Acc, 0 ),
        Acc#{ P => N+1 }
      end,

  % gather count map
  CountMap = lists:foldl( F, #{}, Preset ),

  G = fun( P, N, Acc ) ->
        #{ P := TkLst } = Marking,
        Acc#{ P => lib_combin:cnr( N, TkLst ) }
      end,

  % enumerate drawing combinations for each preset place individually
  CmbMap = maps:fold( G, #{}, CountMap ),

  % enumerate permutations of map containing drawing combinations
  lib_combin:permut_map( CmbMap ).