diff options
Diffstat (limited to 'lib/Kratos/DFADriver/DFA.pm')
| -rw-r--r-- | lib/Kratos/DFADriver/DFA.pm | 251 |
1 files changed, 251 insertions, 0 deletions
diff --git a/lib/Kratos/DFADriver/DFA.pm b/lib/Kratos/DFADriver/DFA.pm new file mode 100644 index 0000000..ef834e0 --- /dev/null +++ b/lib/Kratos/DFADriver/DFA.pm @@ -0,0 +1,251 @@ +package Kratos::DFADriver::DFA; + +use strict; +use warnings; +use 5.020; + +use parent 'Class::Accessor'; + +use FLAT::DFA; +use Math::Cartesian::Product; + +Kratos::DFADriver::DFA->mk_ro_accessors(qw(model)); + +our $VERSION = '0.00'; + +sub new { + my ( $class, %opt ) = @_; + + my $self = \%opt; + + bless( $self, $class ); + + return $self; +} + +sub set_model { + my ( $self, $model ) = @_; + + $self->{model} = $model; + + return $self; +} + +sub reduced_id_to_state { + my ( $self, $id ) = @_; + + if ( not( $self->{excluded_states} and @{ $self->{excluded_states} } ) ) { + return $self->model->get_state_name($id); + } + + my @excluded + = map { $self->model->get_state_id($_) } @{ $self->{excluded_states} }; + @excluded = reverse sort { $a <=> $b } @excluded; + my @state_enum = $self->model->get_state_enum; + + for my $state (@excluded) { + splice( @state_enum, $state, 1 ); + } + + return $state_enum[$id]; +} + +sub dfa { + my ($self) = @_; + + if ( exists $self->{dfa} ) { + return $self->{dfa}; + } + + my $dfa = FLAT::DFA->new(); + my @state_enum = $self->model->get_state_enum; + + $dfa->add_states( scalar @state_enum ); + $dfa->set_starting(0); + $dfa->set_accepting( $dfa->get_states ); + + for my $transition ( $self->model->transitions ) { + my $destination = $transition->{destination}; + my @argtuples + = cartesian { 1 } map { $_->{values} } @{ $transition->{parameters} }; + + # cartesian will return a one-element list containing a reference to + # an empty array if @{$transition->{parameters}} is empty + + for my $argtuple (@argtuples) { + for my $origin ( @{ $transition->{origins} } ) { + $dfa->add_transition( + $self->model->get_state_id($origin), + $self->model->get_state_id($destination), + ':' . $transition->{name} . '!' . join( '!', @{$argtuple} ) + ); + } + } + } + + if ( $self->{excluded_states} and @{ $self->{excluded_states} } ) { + my @to_delete = map { $self->model->get_state_id($_) } + @{ $self->{excluded_states} }; + $dfa->delete_states(@to_delete); + } + + $self->{dfa} = $dfa; + + say $dfa->as_summary; + + return $dfa; +} + +sub traces { + my ($self) = @_; + + # Warning: This function is not deterministic! + # Therefore, results are cached. When in doubt, reload traces / execution + # plan from DriverEval.json + + if ( exists $self->{traces} ) { + return @{ $self->{traces} }; + } + + my $max_iter = $self->{trace_revisit} // 2; + my $dfa = $self->dfa; + my @state_enum = $self->model->get_state_enum; + my $next = $dfa->new_deepdft_string_generator($max_iter); + my $state_duration = $self->{state_duration} // 1000; + my $trace_id = 1; + + my ( @raw_runs, @traces ); + my $filter_re; + + if ( $self->{trace_filter} and @{ $self->{trace_filter} } ) { + my @res; + for my $filter ( @{ $self->{trace_filter} } ) { + my $re = $filter; + $re =~ s{,}{![^:]*:}g; + $re =~ s{$}{![^:]*)}; + $re =~ s{^}{(^}; + push( @res, $re ); + } + $filter_re = join( q{|}, @res ); + } + + while ( my $run = $next->() ) { + $run = substr( $run, 1 ); + if ( $filter_re and not $run =~ m{$filter_re} ) { + next; + } + @raw_runs = grep { $_ ne substr( $run, 0, length($_) ) } @raw_runs; + push( @raw_runs, $run ); + } + + if ( @raw_runs == 0 ) { + say STDERR "--trace-filter did not match any run. Aborting."; + exit 1; + } + + @raw_runs = sort @raw_runs; + + for my $run_str (@raw_runs) { + my @trace; + my %param = $self->model->parameter_hash; + my $state = 0; + my $prev_transition = {}; + for my $transition_str ( split( qr{ : }x, $run_str ) ) { + my ( $cmd, @args ) = split( qr{ ! }x, $transition_str ); + my $state_name = $self->reduced_id_to_state($state); + my $transition = $self->model->get_transition_by_name($cmd); + + push( + @trace, + { + isa => 'state', + name => $state_name, + plan => { + time => $prev_transition->{timeout}{static} + // $state_duration, + power => $self->model->get_state_power($state_name), + energy => $self->model->get_state_power($state_name) + * $state_duration, + }, + parameter => + { map { $_ => $param{$_}{value} } keys %param, }, + }, + { + isa => 'transition', + name => $cmd, + args => [@args], + code => [ $cmd, @args ], + plan => { + level => $transition->{level}, + energy => $transition->{energy}{static}, + timeout => $transition->{timeout}{static}, + }, + parameter => + { map { $_ => $param{$_}{value} } keys %param, }, + }, + ); + + $self->model->update_parameter_hash( \%param, $cmd, @args ); + + ($state) = $dfa->successors( $state, ":${transition_str}" ); + $prev_transition = $transition; + for my $extra_cmd ( + $self->model->get_state_extra_transitions( + $state_enum[$state] + ) + ) + { + $state_name = $self->reduced_id_to_state($state); + $transition = $self->model->get_transition_by_name($extra_cmd); + push( + @trace, + { + isa => 'state', + name => $state_name, + plan => { + time => $prev_transition->{timeout}{static} + // $state_duration, + power => $self->model->get_state_power($state_name), + energy => $self->model->get_state_power($state_name) + * $state_duration, + }, + parameter => + { map { $_ => $param{$_}{value} } keys %param, }, + }, + { + isa => 'transition', + name => $extra_cmd, + args => [], + code => [$extra_cmd], + plan => { + level => $transition->{level}, + energy => $transition->{energy}{static}, + timeout => $transition->{timeout}{static}, + }, + parameter => + { map { $_ => $param{$_}{value} } keys %param, }, + } + ); + $prev_transition = $transition; + } + } + + # required for unscheduled extra states and transitions caused by interrupts + $trace[-1]{final_parameter} + = { map { $_ => $param{$_}{value} } keys %param, }, + push( + @traces, + { + id => $trace_id, + trace => [@trace], + } + ); + $trace_id++; + } + + $self->{traces} = [@traces]; + + return @traces; +} + +1; |