sub results from the CPAN

example/PSOTest-MultiCore.pl view on Meta::CPAN

#use AI::ParticleSwarmOptimization;
use AI::ParticleSwarmOptimization::MCE;
#use AI::ParticleSwarmOptimization::Pmap;
use Data::Dumper; $::Data::Dumper::Sortkeys = 1;
#=======================================================================
sub calcFit {
    my @values = @_;
    my $offset = int (-@values / 2);
    my $sum;

	select( undef, undef, undef, 0.01 );	# Simulation of heavy processing...

view all matches for this distribution

AI-ParticleSwarmOptimization-Pmap

5 results

example/PSOTest-MultiCore.pl view on Meta::CPAN

#use AI::ParticleSwarmOptimization;
#use AI::ParticleSwarmOptimization::MCE;
use AI::ParticleSwarmOptimization::Pmap;
use Data::Dumper; $::Data::Dumper::Sortkeys = 1;
#=======================================================================
sub calcFit {
    my @values = @_;
    my $offset = int (-@values / 2);
    my $sum;

	select( undef, undef, undef, 0.01 );	# Simulation of heavy processing...

view all matches for this distribution

AI-ParticleSwarmOptimization

5 results

Samples/PSOPlatTest.pl view on Meta::CPAN


printf ",# Fit %.5f at (%s) after %d iterations\n",
    $fit, join (', ', map {sprintf '%.4f', $_} @values), $iters;


sub calcFit {
    my @values = @_;
    my $offset = int (-@values / 2);
    my $sum;

    $sum += ($_ - $offset++)**2 for @values;

view all matches for this distribution

AI-Pathfinding-AStar-Rectangle

7 results

my ( $x_start, $y_start ) = ( WIDTH_X >> 1, WIDTH_Y >> 1 );
my ( $x_end, $y_end ) = ( 0, 0 );

my $t0 = [gettimeofday];
my $path;
my $r = timethese( -1, {Perl=>sub { astar( $x_start, $y_start, $x_end, $y_end ) },
                XS=>sub {$m->astar($x_start, $y_start, $x_end, $y_end);}});
cmpthese($r);
die;
for (0..99) {
    $path = &astar( $x_start, $y_start, $x_end, $y_end );
}

    }
    print "$y\n";
}


sub astar
{
    my ( $xs, $ys, $xe, $ye ) = @_;
    my %close;
    my ( %open, @g, @h, @r, @open_idx );
    for my $x (0 .. WIDTH_X - 1 )

    }
#   print  "Path: $path\n";
    return $path;
}

sub calc_obstacle
{
    my ( $x1, $y1, $x2, $y2 ) = @_;
    my ( $x, $y, $Xend, $obstacle, $pixel);
    my $dx = abs($x2 - $x1);
    my $dy = abs($y2 - $y1);

        };

    return ( $obstacle << 3 ) + $pixel;
}

sub deb
{
    my ( $x, $y, $xn, $yn, $g) = @_;
    for my $j ( 0 .. WIDTH_Y - 1 )
    {
        for my $i ( 0 .. WIDTH_X - 1 )

view all matches for this distribution

AI-Pathfinding-AStar

5 results

use Heap::Binomial;

use AI::Pathfinding::AStar::AStarNode;
my $nodes;

sub _init {
    my $self = shift;
    croak "no getSurrounding() method defined" unless $self->can("getSurrounding");

    return $self->SUPER::_init(@_);
}

sub doAStar
{
	my ($map, $target, $open, $nodes, $max) = @_;

	my $n = 0;
	FLOOP:	while ( (defined $open->top()) && ($open->top()->{id} ne $target) ) {

			}
		}
	}
}

sub fillPath
{
	my ($map,$open,$nodes,$target) = @_;
	my $path = [];

        my $curr_node = (exists $nodes->{$target}) ? $nodes->{$target} : $open->top();

	}
	return $path;
}


sub findPath {
	my ($map, $start, $target) = @_;

	my $nodes = {};
	my $curr_node = undef;

	my $path = $map->fillPath($open,$nodes,$target);

	return wantarray ? @{$path} : $path;
}

sub findPathIncr {
	my ($map, $start, $target, $state, $max) = @_;

	my $open = undef;
	my $curr_node = undef;;
	my $nodes = {};


  package My::Map::Package;
  use base AI::Pathfinding::AStar;

  # Methods required by AI::Pathfinding::AStar
  sub getSurrounding { ... }

  package main;
  use My::Map::Package;

  my $map = My::Map::Package->new or die "No map for you!";

  }
  print "Completed Path: ", join(', ', @{$state->{path}}), "\n";
  
=head1 DESCRIPTION

This module implements the A* pathfinding algorithm.  It acts as a base class from which a custom map object can be derived.  It requires from the map object a subroutine named C<getSurrounding> (described below) and provides to the object two routin...

AI::Pathfinding::AStar requires that the map object define a routine named C<getSurrounding> which accepts the starting and target node ids for which you are calculating the path.  In return it should provide an array reference containing the followi...

=over

view all matches for this distribution

AI-Pathfinding-OptimizeMultiple

14 results

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN


use PDL;
use Scalar::Util qw/ blessed /;

has chosen_scans     => ( isa => 'ArrayRef', is => 'rw' );
has _iter_idx        => ( isa => 'Int', is => 'rw', default  => sub { 0; }, );
has _num_boards      => ( isa => 'Int', is => 'ro', init_arg => 'num_boards', );
has _orig_scans_data => ( isa => 'PDL', is => 'rw' );
has _optimize_for => ( isa => 'Str', is => 'ro', init_arg => 'optimize_for', );
has _scans_data   => ( isa => 'PDL', is => 'rw' );
has _selected_scans =>

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

    ( isa => 'HashRef', is => 'rw', init_arg => 'scans_iters_pdls' );
has _stats_factors => (
    isa      => 'HashRef',
    is       => 'ro',
    init_arg => 'stats_factors',
    default  => sub { return +{}; },
);

sub BUILD
{
    my $self = shift;

    my $args = shift;

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN


my $BOARDS_DIM     = 0;
my $SCANS_DIM      = 1;
my $STATISTICS_DIM = 2;

sub _next_iter_idx
{
    my $self = shift;

    my $ret = $self->_iter_idx();

    $self->_iter_idx( $ret + 1 );

    return $ret;
}

sub _get_next_quota
{
    my $self = shift;

    my $iter = $self->_next_iter_idx();

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

    {
        return $self->_quotas()->($iter);
    }
}

sub _calc_get_iter_state_param_method
{
    my $self = shift;

    my $optimize_for = $self->_optimize_for();

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

    );

    return $resolve{$optimize_for};
}

sub _get_iter_state_params
{
    my $self = shift;

    my $method = $self->_calc_get_iter_state_param_method();

    return $self->$method();
}

sub _my_sum_over
{
    my $pdl = shift;

    return $pdl->sumover()->slice(":,(0)");
}

sub _my_xchg_sum_over
{
    my $pdl = shift;

    return _my_sum_over( $pdl->xchg( 0, 1 ) );
}

sub _get_iter_state_params_len
{
    my $self = shift;

    my $iters_quota        = 0;
    my $num_solved_in_iter = 0;

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

        num_solved => $num_solved_in_iter,
        scan_idx   => $selected_scan_idx,
    };
}

sub _get_iter_state_params_minmax_len
{
    my $self = shift;

    my $iters_quota        = 0;
    my $num_solved_in_iter = 0;

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

        num_solved => $num_solved_in_iter,
        scan_idx   => $selected_scan_idx,
    };
}

sub _get_iter_state_params_speed
{
    my $self = shift;

    my $iters_quota        = 0;
    my $num_solved_in_iter = 0;

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

        num_solved => $num_solved_in_iter->at(0),
        scan_idx   => $selected_scan_idx->at(0),
    };
}

sub _get_selected_scan
{
    my $self = shift;

    my $iter_state =
        AI::Pathfinding::OptimizeMultiple::IterState->new(

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

    $iter_state->attach_to($self);

    return $iter_state;
}

sub _inspect_quota
{
    my $self = shift;

    my $state = $self->_get_selected_scan();

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

    }

    $state->detach();
}

sub calc_meta_scan
{
    my $self = shift;

    $self->chosen_scans( [] );

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

    }

    return;
}

sub _get_num_scans
{
    my $self = shift;

    return ( ( $self->_scans_data()->dims() )[$SCANS_DIM] );
}

sub _calc_chosen_scan
{
    my ( $self, $selected_scan_idx, $iters_quota ) = @_;

    return AI::Pathfinding::OptimizeMultiple::ScanRun->new(
        {

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

            scan_idx => $selected_scan_idx,
        }
    );
}

sub calc_flares_meta_scan
{
    my $self = shift;

    $self->chosen_scans( [] );

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

" ; #Solved = $num_solved ; Iters = $total_num_iters ; Avg = $min_avg\n";
        STDOUT->flush();
    }
}

sub calc_board_iters
{
    my $self  = shift;
    my $board = shift;

    my $board_iters = 0;

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

        'per_scan_iters' => \@orig_info,
        'board_iters'    => $board_iters,
    };
}

sub get_final_status
{
    my $self = shift;

    return $self->_status();
}

sub simulate_board
{
    my ( $self, $board_idx, $args ) = @_;

    if ( $board_idx !~ /\A[0-9]+\z/ )
    {

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN


    my @scan_runs;

    my $status = "Unsolved";

    my $add_new_scan_run = sub {
        my $scan_run = shift;

        push @scan_runs, $scan_run;

        $board_iters += $scan_run->iters();

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

            total_iters => $board_iters,
        }
    );
}

sub _trace
{
    my ( $self, $args ) = @_;

    if ( my $trace_callback = $self->_trace_cb() )
    {

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

    }

    return;
}

sub get_total_iters
{
    my $self = shift;

    return $self->_total_iters();
}

sub _add_to_total_iters
{
    my $self = shift;

    my $how_much = shift;

    $self->_total_iters( $self->_total_iters() + $how_much );

    return;
}

sub _add_to_total_boards_solved
{
    my $self = shift;

    my $how_much = shift;

lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
L<https://github.com/shlomif/fc-solve/issues>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 COPYRIGHT AND LICENSE

view all matches for this distribution

AI-Pathfinding-SMAstar

11 results



##################################################
# SMAstar constructor 
##################################################
sub new {
    my $invocant = shift;
    my $class   = ref($invocant) || $invocant;
    my $self = { 
     
	_priority_queue => AI::Pathfinding::SMAstar::PriorityQueue->new(),

    };
    return bless $self, $class;
}


sub state_eval_func {
    my $self = shift;
    if (@_) { $self->{_state_eval_func} = shift }
    return $self->{_state_eval_func};
}

sub state_goal_p_func {
    my $self = shift;
    if (@_) { $self->{_state_goal_p_func} = shift }
    return $self->{_state_goal_p_func};    
}

sub state_num_successors_func {
    my $self = shift;
    if (@_) { $self->{_state_num_successors_func} = shift }
    return $self->{_state_num_successors_func};    
}

sub state_successors_iterator {
    my $self = shift;
    if (@_) { $self->{_state_successors_iterator} = shift }
    return $self->{_state_successors_iterator};    
}

sub state_get_data_func {
    my $self = shift;
    if (@_) { $self->{_state_get_data_func} = shift }
    return $self->{_state_get_data_func};    
}

sub show_prog_func {
    my $self = shift;
    if (@_) { $self->{_show_prog_func} = shift }
    return $self->{_show_prog_func};    
}

#
# Add a state from which to begin the search.   There can 
# be multiple start-states.
#
###################################################################
sub add_start_state
{
    my ($self, $state) = @_;


    my $state_eval_func = $self->{_state_eval_func};

###################################################################
#
# start the SMAstar search process
#
###################################################################
sub start_search
{
    my ($self, 
	$log_function,
	$str_function,
	$max_states_in_queue,

#  SMAstar search
#  Memory-bounded A* search
#
#
#################################################################
sub sma_star_tree_search
{
   
    my ($priority_queue,
	$goal_p,
	$successors_func,



		    # Check if need for backup fvals		    
		    $best->check_need_fval_change();
		   
		    my $cmp_func = sub {
			my ($str) = @_;			
			return sub{
			    my ($obj) = @_;
			    my $obj_path_str = $str_function->($obj);
			    if($obj_path_str eq $str){
				return 1;
			    }

		    
		    if(!($best->is_completed())){
			$best->is_completed(1);
		    }

		    my $cmp_func = sub {
			my ($str) = @_;			
			return sub{
			    my ($obj) = @_;
			    my $obj_str = $str_function->($obj);
			    if($obj_str eq $str){
				return 1;
			    }

}    




sub max
{
    my ($n1, $n2) = @_;
    return ($n1 > $n2 ? $n1 : $n2);
}


sub fp_compare {
    my ($a, $b, $dp) = @_;
    my $a_seq = sprintf("%.${dp}g", $a);
    my $b_seq = sprintf("%.${dp}g", $b);



For solution spaces with these characteristics, stochastic methods or
approximation algorithms such as I<Simulated Annealing> can provide a
massive reduction in time and space requirements, while introducing a
tunable probability of producing a sub-optimal solution.


=head1 METHODS

    $MAX_COST,            # indicate the maximum cost allowed in search
    );

Initiates a memory-bounded search.  When calling this function, pass a handle to
a function for recording current status( C<log_function> above- this can be
an empty subroutine if you don't care), a function that returns a *unique* string
representing a node in the search-space (this *cannot* be an empty subroutine), a
maximum number of expanded states to store in the queue, and a maximum cost
value (beyond which the search will cease).


=head2 state_eval_func()

=head2 show_prog_func()

 $smatar->show_prog_func(\&FrontierObj::progress_callback);

Sets/gets the callback function for displaying the progress of the search.
It can be an empty callback (sub{}) if you do not need this output.



=head2 DEPENDENCIES

view all matches for this distribution

AI-Perceptron-Simple

12 results


=head1 EXPORT

None by default.

All the subroutines from C<DATA PROCESSING RELATED SUBROUTINES>, C<NERVE DATA RELATED SUBROUTINES> and C<NERVE PORTABILITY RELATED SUBROUTINES> sections are importable through tags or manually specifying them.

The tags available include the following:

=over 4

=item C<:process_data> - subroutines under C<DATA PROCESSING RELATED SUBROUTINES> section.

=item C<:local_data> - subroutines under C<NERVE DATA RELATED SUBROUTINES> section.

=item C<:portable_data> - subroutines under C<NERVE PORTABILITY RELATED SUBROUTINES> section.

=back

Most of the stuff are OO.


=head1 DESCRIPTION

This module provides methods to build, train, validate and test a perceptron. It can also save the data of the perceptron for future use for any actual AI programs.

This module is also aimed to help newbies grasp hold of the concept of perceptron, training, validation and testing as much as possible. Hence, all the methods and subroutines in this module are decoupled as much as possible so that the actual script...

The implementation here is super basic as it only takes in input of the dendrites and calculate the output. If the output is higher than the threshold, the final result (category) will 
be 1 aka perceptron is activated. If not, then the result will be 0 (not activated).

Depending on how you view or categorize the final result, the perceptron will fine tune itself (aka train) based on the learning rate until the desired result is met. Everything from

Therefore, the perceptron should be trained for as many rounds as possible. The more "confusion" the perceptron is able to correctly handle, the more "mature" the perceptron is. 
No one defines how "mature" it is except the programmer himself/herself :)

=head1 CONVENTIONS USED

Please take note that not all subroutines/method must be used to make things work. All the subroutines and methods are listed out for the sake of writing the documentation. 

Private methods/subroutines are prefixed with C<_> or C<&_> and they aren't meant to be called directly. You can if you want to. There are quite a number of them to be honest, just ignore them if you happen to see them :)

Synonyms are placed before the actual ie. technical subroutines/methods. You will see C<...> as the parameters if they are synonyms. Move to the next subroutine/method until you find something like C<\%options> as the parameter or anything that isn't...

=head1 DATASET STRUCTURE

I<This module can only process CSV files.>


See C<Portability of Nerve Data> section below for more info on some known issues.

=head1 DATA PROCESSING RELATED SUBROUTINES

These subroutines can be imported using the tag C<:process_data>.

These subroutines should be called in the procedural way.

=head2 shuffle_stimuli ( ... )

The parameters and usage are the same as C<shuffled_data>. See the next two subroutines.

=head2 shuffle_data ( $original_data => $shuffled_1, $shuffled_2, ... )

=head2 shuffle_data ( ORIGINAL_DATA, $shuffled_1, $shuffled_2, ... )

Shuffles C<$original_data> or C<ORIGINAL_DATA> and saves them to other files.

=cut

sub shuffle_stimuli {
    shuffle_data( @_ );
}

sub shuffle_data {
    my $stimuli = shift or croak "Please specify the original file name";
    my @shuffled_stimuli_names = @_ 
        or croak "Please specify the output files for the shuffled data";
    
    my @aoa;


=back

=cut

sub new {
    my $class = shift;
    
    my $data_ref = shift;
    my %data = %{ $data_ref };
    
    # check keys
    $data{ learning_rate } = LEARNING_RATE if not exists $data{ learning_rate };
    $data{ threshold } = THRESHOLD if not exists $data{ threshold };
    
    #####
    # don't pack this key checking process into a subroutine for now
    # this is also used in &_real_validate_or_test
    my @missing_keys;
    for ( qw( initial_value attribs ) ) {
        push @missing_keys, $_ unless exists $data{ $_ };
    }


Obtains a hash of all the attributes of the perceptron

=cut

sub get_attributes {
    my $self = shift;
    %{ $self->{attributes_hash_ref} };
}

=head2 learning_rate ( $value )


If C<$value> is given, sets the learning rate to C<$value>. If not, then it returns the learning rate.

=cut

sub learning_rate {
    my $self = shift;
    if ( @_ ) {
        $self->{learning_rate} = shift;
    } else {
        $self->{learning_rate}


If C<$value> is given, sets the threshold / passing rate to C<$value>. If not, then it returns the passing rate.

=cut

sub threshold {
    my $self = shift;
    if ( @_ ) {
        $self->{ threshold } = shift;
    } else {
        $self->{ threshold };


If C<$display_stats> is specified ie. set to C<1>, then you B<MUST> specify the C<$identifier>. C<$identifier> is the column / header name that is used to identify a specific row of data in C<$stimuli_train_csv>.

=cut

sub tame {
    train( @_ );
}

sub exercise {
    train( @_ );
}

sub train {
    my $self = shift;
    my( $stimuli_train_csv, $expected_output_header, $save_nerve_to_file, $display_stats, $identifier ) = @_;
    
    $display_stats = 0 if not defined $display_stats;
    if ( $display_stats and not defined $identifier ) {


C<%stimuli_hash> is the actual data to be used for training. It might contain useless columns.

This will get all the avaible dendrites using the C<get_attributes> method and then use all the keys ie. headers to access the corresponding values.

This subroutine should be called in the procedural way for now.

=cut

sub _calculate_output {
    my $self = shift; 
    my $stimuli_hash_ref = shift;
    
    my %dendrites = $self->get_attributes;
    my $sum; # this is the output


Value is C<0>

=back

This subroutine should be called in the procedural way for now.

=cut

sub _tune {
    my $self = shift; 
    my ( $stimuli_hash_ref, $tuning_status ) = @_;

    my %dendrites = $self->get_attributes;


I<*This method will call C<_real_validate_or_test> to do the actual work.>

=cut

sub take_mock_exam {
    my ( $self, $data_hash_ref ) = @_;
    $self->_real_validate_or_test( $data_hash_ref );
}

sub take_lab_test {
    my ( $self, $data_hash_ref ) = @_;
    $self->_real_validate_or_test( $data_hash_ref );
}

sub validate {
    my ( $self, $data_hash_ref ) = @_;
    $self->_real_validate_or_test( $data_hash_ref );
}

=head1 TESTING RELATED SUBROUTINES/METHODS

I<*This method will call &_real_validate_or_test to do the actual work.>

=cut

# redirect to _real_validate_or_test
sub take_real_exam {
    my ( $self, $data_hash_ref ) = @_;
    $self->_real_validate_or_test( $data_hash_ref );
}

sub work_in_real_world {
    my ( $self, $data_hash_ref ) = @_;
    $self->_real_validate_or_test( $data_hash_ref );
}

sub test {
    my ( $self, $data_hash_ref ) = @_;
    $self->_real_validate_or_test( $data_hash_ref );
}

=head2 _real_validate_or_test ( $data_hash_ref )

This is where the actual validation or testing takes place. 

C<$data_hash_ref> is the list of parameters passed into the C<validate> or C<test> methods.

This is a B<method>, so use the OO way. This is one of the exceptions to the rules where private subroutines are treated as methods :)

=cut

sub _real_validate_or_test {

    my $self = shift;   my $data_hash_ref = shift;
    
    #####
    my @missing_keys;


=head2 &_fill_predicted_values ( $self, $stimuli_validate, $predicted_index, $aoa )

This is where the filling in of the predicted values takes place. Take note that the parameters naming are the same as the ones used in the C<validate> and C<test> method.

This subroutine should be called in the procedural way.

=cut

sub _fill_predicted_values {
    my ( $self, $stimuli_validate, $predicted_index, $aoa ) = @_;

    # CSV processing is all according to the documentation of Text::CSV
    open my $data_fh, "<:encoding(UTF-8)", $stimuli_validate 
        or croak "Can't open $stimuli_validate: $!";


=back

=cut

sub get_exam_results {

    my ( $self, $info ) = @_;
    
    $self->get_confusion_matrix( $info );
}

sub get_confusion_matrix {

    my ( $self, $info ) = @_;

    my %c_matrix = _collect_stats( $info ); # processes total_entries, accuracy, sensitivity etc


Generates a hash of confusion matrix based on C<%options> given in the C<get_confusion_matrix> method.

=cut

sub _collect_stats {
    my $info = shift;
    my $file = $info->{ full_data_file };
    my $actual_header = $info->{ actual_output_header };
    my $predicted_header = $info->{ predicted_output_header };
    my $more_stats = defined ( $info->{ more_stats } ) ? 1 : 0;

    $csv->column_names( $attrib );

    # individual row
    while ( my $row = $csv->getline_hr($data_fh) ) {
        
        # don't pack this part into another subroutine, number of rows can be very big
        if ( $row->{ $actual_header } == 1 and $row->{ $predicted_header } == 1 ) {

            # true positive
            $c_matrix{ true_positive }++;


Calculates and adds the data for the C<total_entries> key in the confusion matrix hash.

=cut

sub _calculate_total_entries {

    my $c_matrix = shift;
    my $total = $c_matrix->{ true_negative } + $c_matrix->{ false_positive };
       $total += $c_matrix->{ false_negative } + $c_matrix->{ true_positive };


Calculates and adds the data for the C<accuracy> key in the confusion matrix hash.

=cut

sub _calculate_accuracy {

    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ true_positive } + $c_matrix->{ true_negative };
    my $denominator = $numerator + $c_matrix->{ false_positive } + $c_matrix->{ false_negative };


Calculates and adds the data for the C<sensitivity> key in the confusion matrix hash.

=cut

sub _calculate_sensitivity {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ true_positive };
    my $denominator = $numerator + $c_matrix->{ false_negative };


Calculates and adds the data for the C<precision> key in the confusion matrix hash.

=cut

sub _calculate_precision {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ true_positive };
    my $denominator = $numerator + $c_matrix->{ false_positive };


Calculates and adds the data for the C<specificity> key in the confusion matrix hash.

=cut

sub _calculate_specificity {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ true_negative };
    my $denominator = $numerator + $c_matrix->{ false_positive };


Calculates and adds the data for the C<F1_Score> key in the confusion matrix hash.

=cut

sub _calculate_f1_score {
    my $c_matrix = shift;
    
    my $numerator = 2 * $c_matrix->{ true_positive };
    my $denominator = $numerator + $c_matrix->{ false_positive } + $c_matrix->{ false_negative };


Calculates and adds the data for the C<negative_predicted_value> key in the confusion matrix hash.

=cut

sub _calculate_negative_predicted_value {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ true_negative };
    my $denominator = $numerator + $c_matrix->{ false_negative };


Calculates and adds the data for the C<false_negative_rate> key in the confusion matrix hash.

=cut

sub _calculate_false_negative_rate {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ false_negative };
    my $denominator = $numerator + $c_matrix->{ true_positive };


Calculates and adds the data for the C<false_positive_rate> key in the confusion matrix hash.

=cut

sub _calculate_false_positive_rate {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ false_positive };
    my $denominator = $numerator + $c_matrix->{ true_negative };


Calculates and adds the data for the C<false_discovery_rate> key in the confusion matrix hash.

=cut

sub _calculate_false_discovery_rate {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ false_positive };
    my $denominator = $numerator + $c_matrix->{ true_positive };


Calculates and adds the data for the C<false_omission_rate> key in the confusion matrix hash.

=cut

sub _calculate_false_omission_rate {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ false_negative };
    my $denominator = $numerator + $c_matrix->{ true_negative };


Calculates and adds the data for the C<balanced_accuracy> key in the confusion matrix hash.

=cut

sub _calculate_balanced_accuracy {
    my $c_matrix = shift;
    
    my $numerator = $c_matrix->{ sensitivity } + $c_matrix->{ specificity };
    my $denominator = 2;


For the C<%labels>, there is no need to enter "actual X", "predicted X" etc. It will be prefixed with C<A: > for actual and C<P: > for the predicted values by default.

=cut

sub display_exam_results {

    my ( $self, $c_matrix, $labels ) = @_;
    
    $self->display_confusion_matrix( $c_matrix, $labels );
}

sub display_confusion_matrix {
    my ( $self, $c_matrix, $labels ) = @_;
    
    #####
    my @missing_keys;
    for ( qw( zero_as one_as ) ) {


Returns a list C<( $matrix, $c_matrix )> which can directly be passed to C<_print_extended_matrix>.

=cut

sub _build_matrix {

    my ( $c_matrix, $labels ) = @_;

    my $predicted_columns = [ "P: ".$labels->{ zero_as }, "P: ".$labels->{ one_as }, "Sum" ];
    my $actual_rows = [ "A: ".$labels->{ zero_as }, "A: ".$labels->{ one_as }, "Sum"];


C<$matrix> and C<$c_matrix> are the same as returned by C<&_build_matrix>.

=cut

sub _print_extended_matrix {

    my ( $matrix, $c_matrix ) = @_;
    
    print "~~" x24, "\n";
    print "CONFUSION MATRIX (A:actual  P:predicted)\n";

    print "~~" x24, "\n";
}

=head1 NERVE DATA RELATED SUBROUTINES

This part is about saving the data of the nerve. These subroutines can be imported using the C<:local_data> tag.

B<The subroutines are to be called in the procedural way>. No checking is done currently.

See C<PERCEPTRON DATA> and C<KNOWN ISSUES> sections for more details on the subroutines in this section.

=head2 preserve ( ... )

The parameters and usage are the same as C<save_perceptron>. See the next subroutine.

=head2 save_perceptron ( $nerve, $nerve_file )

Saves the C<AI::Perceptron::Simple> object into a C<Storable> file. There shouldn't be a need to call this method manually since after every training 
process this will be called automatically.

=cut

sub preserve {
    save_perceptron( @_ );
}

sub save_perceptron {
    my $self = shift;
    my $nerve_file = shift;
    use Storable;
    store $self, $nerve_file;
    no Storable;
}

=head2 revive (...)

The parameters and usage are the same as C<load_perceptron>. See the next subroutine.

=head2 load_perceptron ( $nerve_file_to_load )

Loads the data and turns it into a C<AI::Perceptron::Simple> object as the return value.

=cut

sub revive {
    load_perceptron( @_ );
}

sub load_perceptron {
    my $nerve_file_to_load = shift;
    use Storable;
    my $loaded_nerve = retrieve( $nerve_file_to_load );
    no Storable;
    
    $loaded_nerve;
}

=head1 NERVE PORTABILITY RELATED SUBROUTINES

These subroutines can be imported using the C<:portable_data> tag.

The file type currently supported is YAML. Please be careful with the data as you won't want the nerve data accidentally modified.

=head2 preserve_as_yaml ( ... )

The parameters and usage are the same as C<save_perceptron_yaml>. See the next subroutine.

=head2 save_perceptron_yaml ( $nerve, $yaml_nerve_file )

Saves the C<AI::Perceptron::Simple> object into a C<YAML> file.

=cut

sub preserve_as_yaml {
    save_perceptron_yaml( @_ );
}

sub save_perceptron_yaml {
    my $self = shift;
    my $nerve_file = shift;
    use YAML;
    YAML::DumpFile( $nerve_file, $self );
    no YAML;
}

=head2 revive_from_yaml (...)

The parameters and usage are the same as C<load_perceptron>. See the next subroutine.

=head2 load_perceptron_yaml ( $yaml_nerve_file )

Loads the YAML data and turns it into a C<AI::Perceptron::Simple> object as the return value.

=cut

sub revive_from_yaml {
    load_perceptron_yaml( @_ );
}

sub load_perceptron_yaml {
    my $nerve_file_to_load = shift;
    use YAML;
    local $YAML::LoadBlessed = 1;
    my $loaded_nerve = YAML::LoadFile( $nerve_file_to_load );
    no YAML;


=head2 Portability of Nerve Data

Take note that the C<Storable> nerve data is not compatible across different versions.

If you really need to send the nerve data to different computers with different versions of C<Storable> module, see the docs of the following subroutines: 

=over 4

=item * C<&preserve_as_yaml> or C<&save_perceptron_yaml> for storing data.

view all matches for this distribution

AI-Perceptron

2 results

examples/and.pl view on Meta::CPAN

$p->train( @training_exs );

print "\nAfter Training\n";
dump_perceptron( $p );

sub dump_perceptron {
    my $p = shift;
    print "\tThreshold: ", $p->threshold, " Weights: ", join(', ', @{ $p->weights }), "\n";
    foreach my $inputs (@training_exs) {
	my $target = $inputs->[0];
	print "\tInputs = {", join(',', @$inputs[1..2]), "}, target=$target, output=", $p->compute_output( @$inputs[1..2] ), "\n";

view all matches for this distribution

AI-PredictionClient-Alien-TensorFlowServingProtos

6 results

LICENSE view on Meta::CPAN

exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.

  4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License.  However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.

LICENSE view on Meta::CPAN

on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.

  6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions.  You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.

  7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time.  Such new versions will

LICENSE view on Meta::CPAN

6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.

7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.

8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.

view all matches for this distribution

AI-PredictionClient

9 results

bin/Inception.pl view on Meta::CPAN

  is       => 'ro',
  required => 0,
  doc      => "Test using camel image"
);

sub run {
  my ($self) = @_;

  my $image_ref = $self->read_image($self->image_file);

  my $client = AI::PredictionClient::InceptionClient->new(

bin/Inception.pl view on Meta::CPAN

    return 1;
  }
  return 0;
}

sub read_image {
  my $self = shift;

  return \'' if $self->debug_camel;

  my $file_name     = shift;

view all matches for this distribution

AI-Prolog

32 results

examples/benchmark.pl view on Meta::CPAN

}
my $t1 = new Benchmark;
my $td = timediff($t1, $t0);
print "the code took:",timestr($td),"\n";

sub benchmark {
    return <<"    END_BENCHMARK";
    append([],X,X).
    append([X|Xs],Y,[X|Z]) :- 
        append(Xs,Y,Z). 
    nrev([],[]).

view all matches for this distribution

AI-SimulatedAnnealing

3 results

# specifying the number of randomization cycles to perform at each
# temperature during the annealing process.
#
# The function returns a reference to an array containing the
# optimized list of numbers.
sub anneal {
    my $number_specs = validate_number_specs($_[0]);
    my $cost_function = $_[1];
    my $cycles_per_temperature = $_[2];

    my $current_temperature;

        $current_temperature = floor(
          $current_temperature * $TEMPERATURE_MULTIPLIER);
    } # end while

    return \@optimized_list;
} # end sub

####
# Private helper functions for use by this module:

# The use_brute_force() function takes a reference to an array of number

# (which takes a list of numbers matching the specifications and returns a
# number representing a cost to be minimized).  The method tests every
# possible combination of numbers matching the specifications and returns a
# reference to an array containing the optimal numbers, where "optimal"
# means producing the lowest cost.
sub use_brute_force {
    my $number_specs = validate_number_specs($_[0]);
    my $cost_function = $_[1];

    my @optimized_list;
    my @lists;

        } # next $dex
    } until ($finished);

    # Return the result:
    return \@optimized_list;
} # end sub

# The validate_number_specs() function takes a reference to an array of
# number specifications (which are references to hashes with "LowerBound",
# "UpperBound", and "Precision" fields) and returns a reference to a version
# of the array in which bounds with higher precision than that specified
# have been rounded inward.  If a number specification is not valid, the
# function calls "die" with an error message.
sub validate_number_specs {
    my $raw_number_specs = $_[0];
    my @processed_number_specs = @{ $raw_number_specs };

    for my $number_spec (@processed_number_specs) {
        my $lower_bound = $number_spec->{"LowerBound"};

        $number_spec->{"UpperBound"}
          = $integral_upper_bound / (10 ** $precision);
    } # next $number_spec

    return \@processed_number_specs;
} # end sub

# Module return value:
1;
__END__

annealing is immediately terminated.

  NOTE:  Annealing can sometimes complete before the temperature
  reaches zero if, after a particular temperature reduction, a
  brute-force optimization approach (that is, testing every possible
  combination of numbers within the subranges determined by the new
  temperature) would produce a number of tests that is less than or
  equal to the specified cycles per temperature.  In that case, the
  anneal() function performs the brute-force optimization to complete
  the annealing process.

After a temperature reduction, the anneal() function determines each
new subrange such that the current optimal integer from the total
range is as close as possible to the center of the new subrange.
When there is a tie between two possible positions for the subrange
within the total range, a "coin flip" decides.

=head1 PREREQUISITES

This module requires Perl 5, version 5.10.1 or later.

view all matches for this distribution

AI-TensorFlow-Libtensorflow

82 results

lib/AI/TensorFlow/Libtensorflow.pm view on Meta::CPAN

my $ffi = AI::TensorFlow::Libtensorflow::Lib->ffi;
FFI::C->ffi($ffi);

$ffi->mangler(AI::TensorFlow::Libtensorflow::Lib->mangler_default);

sub new {
	my ($class) = @_;
	bless {}, $class;
}

$ffi->attach( 'Version' => [], 'string' );#}}}

view all matches for this distribution

AI-Termites

6 results

use Math::Vector::Real::Random;

use List::Util;
use Carp;

sub new {
    my ($class, %opts) = @_;
    my ($dim, $box);
    $box = delete $opts{box};
    if (defined $box) {
	$box = V(@$box);

    push @termites, $self->new_termite for (1..$n_termites);
    $self->iterate for (1..$iterations);
    $self;
}

sub dim { shift->{dim} }

sub box { shift->{box} }

sub new_wood {
    my $self = shift;
    my $wood = { pos => $self->{box}->random_in_box,
		 taken => 0 };
}

sub new_termite {
    my $self = shift;
    my $termite = { pos => $self->{box}->random_in_box };
}

sub iterate {
    my $self = shift;

    $self->before_termites_move;

    for my $term (@{$self->{termites}}) {

	$self->termite_action($term);
    }
    $self->after_termites_action;
}

sub termite_move {
    my ($self, $termite) = @_;
    $termite->{pos} = $self->{box}->wrap( $termite->{pos} +
					  Math::Vector::Real->random_normal($self->{dim},
									    $self->{speed}));
}

sub before_termites_move {}
sub before_termites_action {}
sub after_termites_action {}

sub termite_action {
    my ($self, $termite) = @_;
    if (defined $termite->{wood_ix}) {
        if ($self->termite_leave_wood_p($termite)) {
            $self->termite_leave_wood($termite);
        }

        my $wood_ix = $self->termite_take_wood_p($termite);
        defined $wood_ix and $self->termite_take_wood($termite, $wood_ix);
    }
}

sub termite_take_wood {
    my ($self, $termite, $wood_ix) = @_;
    my $wood = $self->{wood}[$wood_ix];
    return if $wood->{taken};
    $wood->{taken} = 1;
    $self->{taken}++;
    # print "taken: $self->{taken}\n";
    defined $termite->{wood_ix} and die "termite is already carrying some wood";
    $termite->{wood_ix} = $wood_ix;
}

sub termite_leave_wood {
    my ($self, $termite) = @_;
    my $wood_ix = delete $termite->{wood_ix} //
	croak "termite can not leave wood because it is carrying nothing";
    $self->{taken}--;
    my $wood = $self->{wood}[$wood_ix];


Also, the way they decide when to pick or leave wood are customizable,
allowing to investigate how changing the rules affects the emergent
behaviors.

The module implements several termite subspecies (subclasses):

=over 4

=item LoginquitasPostulo

This termites subspecie measures the distance to the nearest piece of
wood.

=item NemusNidor

This termite smells the wood.

view all matches for this distribution

AI-XGBoost

6 results

examples/iris.pl view on Meta::CPAN


# Split train and test, label and features
my $train_dataset = [map {$iris->{$_}} grep {$_ ne 'species'} keys %$iris];
my $test_dataset = [map {$iris->{$_}} grep {$_ ne 'species'} keys %$iris];

sub transpose {
# Transposing without using PDL, Data::Table, Data::Frame or other modules
# to keep minimal dependencies
    my $array = shift;
    my @aux = ();
    for my $row (@$array) {

view all matches for this distribution

AIIA-GMT

2 results

lib/AIIA/GMT.pm view on Meta::CPAN

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.
my $SERVER_URL = 'http://bcsp1.iis.sinica.edu.tw:8080/aiiagmt/XmlRpcServlet';

sub pmid2entity {
    my $id = shift;
    die "Usage: &pmid2entity(\'PubMed Article ID\');\n" if ($id !~ /^\d+$/);
    return &submit($id);
}

sub text2entity {
    my $txt = shift;
    $txt =~ s/\n//g;
    my $num;
    map {$num++;} split(/\s/, $txt);
    die "Usage: &text2entity(\'less than 3000 words\');\n" if ($num > 3000);
    return &submit($txt);
}

sub submit {
    my @args = (shift);
    my $client = Frontier::Client->new(url => $SERVER_URL, debug => 0);
    my $ret = $client->call('Annotator.getAnnotation', @args);
    my @rep;
    map {push @rep, $_->{'offset'} . "\t" . $_->{'mention'};} @{$ret->{'mentions'}};

view all matches for this distribution

AIS-client

1 match

                # persistence abstraction
	        # that can store and retreive hash references
	        # and has a working DELETE method
	        #
	        # but if you change it, you'll also need to change
	        # the lines that refer to DirDB subsequently,
	        # including the tieing of %{"caller().'::AIS_STASH'}

sub miniget($$$$){
	my($HostName, $PortNumber, $Desired, $agent)  = @_;
	eval <<'ENDMINIGET';
	use Socket qw(:DEFAULT :crlf);
	$PortNumber ||= 80;
	$agent ||= "$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}";


ENDMINIGET

}

sub housekeeping(){

	my @deletia;
	my $t = time;

	while(($k,$v) = each %Sessions){

	};

	@Sessions{@deletia} = ();
};

sub redirect($){
	print <<EOF;
Location: $_[0]
Content-Type: text/html

<HTML><HEAD><TITLE>Relocate </TITLE>


EOF

};

sub import{
	shift;
	my %params = @_;

my $Coo;

			$suffix = 2;
		};
		$ENV{QUERY_STRING}eq'AIS_INITIAL2'and goto NOCOO;
		($Coo = localtime) =~ s/\W//g;
		my @chars = 'A'..'Z' ;
		substr($Coo, rand(length $Coo), 1) = $chars[rand @chars]
		foreach 1..8;
		print "X-Ais-Received-Request-Method: $ENV{REQUEST_METHOD}\n";
		print "X-Ais-Received-Query-String: $ENV{QUERY_STRING}\n";
		$Sessions{$Coo}->{QueryString} = $ENV{QUERY_STRING};
		$ENV{REQUEST_METHOD} =~ /POST/i and

requested as the agent string, but an alternate agent string
can be specified with the C<agent> parameter:

   use AIS::client aissri => "Bob's web services: account MZNXBCV";

It is expected that a subscription-based or otherwise access-controlled
AIS service might issue expiring capability keys which would have to be
listed as part of the agent string.

=item prefix

By default, C<AIS>, which means that AIS::client will store session
data (incliding identity, which is also available as
C<$AIS_STASH{identity}>) in subdirectories under a directory
called C<AIS_sessions> under the current directory
your script runs in.  This can be changed with the C<prefix> parameter:

  use AIS::client prefix => '.AIS'; # hide session directory

view all matches for this distribution

AIX-LPP

2 results

use strict;
use warnings;

our $VERSION = '0.5';

sub new {
    my $class = shift;
    my %param = @_;
    my $self = {};

    if (defined $param{FORMAT}) { $self->{FORMAT} = $param{FORMAT}}

    $self->{FILESET} = {};
    bless $self, $class;
    return $self;
}

sub lpp {
    my $self = shift;
    return ( $self->{NAME},$self->{TYPE},$self->{FORMAT},$self->{PLATFORM},
	keys %{$self->{FILESET}} ) unless @_;
    my %param = @_;
    if (defined $param{FORMAT}) { $self->{FORMAT} = $param{FORMAT}}

    if (defined $param{NAME}) { $self->{NAME} = $param{NAME}}
    return ( $self->{NAME},$self->{TYPE},$self->{FORMAT},$self->{PLATFORM},
	keys %{$self->{FILESET}} );
}

sub fileset {
    my $self = shift;
    my $fsname = shift;
    my %param = @_;
    if ( $#_ == -1 ) {
        return ($self->{FILESET}{$fsname}{NAME},$self->{FILESET}{$fsname}{VRMF},

	$self->{FILESET}{$fsname}{LANG},
	$self->{FILESET}{$fsname}{DESCRIPTION},
	$self->{FILESET}{$fsname}{COMMENTS});
}

sub sizeinfo {
    my $self = shift;
    my $fset = shift;
    my $size_ref = shift;

    $self->{FILESET}{$fset}{SIZEINFO} = $size_ref;
    return $self->{FILESET}{$fset}{SIZEINFO};
}

sub requisites {
    my $self = shift;
    my $fset = shift;
    my $ref_req = shift;

    $self->{FILESET}{$fset}{REQ} = $ref_req;
    return $self->{FILESET}{$fset}{REQ};
}

sub validate {

}

sub read {
    my $class = shift;
    my $fh = shift;
    my $self = {};
    bless $self, $class;

    } while ($line = <$fh>); }

    return $self;
}

sub write {
    my $self = shift;
    my $fh = shift;

    print $fh join ' ', $self->{FORMAT}, $self->{PLATFORM}, $self->{TYPE},
	$self->{NAME}, "{\n";

view all matches for this distribution

AIX-LVM

1 match

					"USED DISTRIBUTION:",
					"MIRROR POOL:"
				);


sub new
{
    my $class = shift;
    my $self = {};
    bless $self, $class;
    return $self->init(@_);
}


sub init 
{
    my $self = shift;
    my ($result, %lslv, %lspv, %lsvg, @lslv, @lsvg, @lspv);
    my ($lsvg, $lsvg_error) = $self->_exec_open3("lsvg -o");
	croak "Error found during execution of lsvg -o: $lsvg_error\n" if $lsvg_error;

	}
    return $self;
}


sub get_logical_volume_group
{
	my $self = shift;
	return sort keys %{$self};
}


sub get_logical_volumes
{
	my $self = shift;
	return map {keys %{$self->{$_}->{lvol}}}keys %{$self};
}


sub get_physical_volumes
{
	my $self = shift;
	return map {keys %{$self->{$_}->{pvol}}}keys %{$self};
}


sub get_volume_group_properties
{
	my $self = shift;
	my $vg   = shift;
	croak "Pass values for Volume Group\n" unless $vg;
	exists $self->{$vg}->{prop}? %{$self->{$vg}->{prop}}:undef;
}


sub get_logical_volume_properties
{
	my $self        = shift;
	my ($vg, $lv)   = (shift, shift);
	croak "Pass values for Volume Group\n" unless $vg;
	croak "Pass values for Logical Volume Group\n" unless $lv;
	exists $self->{$vg}->{lvol}->{$lv}->{prop}? %{$self->{$vg}->{lvol}->{$lv}->{prop}} : undef;
}


sub get_physical_volume_properties
{
	my $self        = shift;
	my ($vg, $pv)   = (shift, shift);
	croak "Pass values for Volume Group\n" unless $vg;
	croak "Pass values for Physical Volume Group\n" unless $pv;
	exists $self->{$vg}->{pvol}->{$pv}->{prop}? %{$self->{$vg}->{pvol}->{$pv}->{prop}} : undef;
}


sub get_PV_PP_command 
{
	my $self        = shift;
	my ($vg, $pv)   = (shift, shift);
	croak "Pass values for Volume Group\n" unless $vg;
	croak "Pass values for Physical Volume Group\n" unless $pv;
	exists $self->{$vg}->{pvol}->{$pv}->{PV_PP_CMD_OUT}? $self->{$vg}->{pvol}->{$pv}->{PV_PP_CMD_OUT} : undef;
}


sub get_PV_LV_command
{
	my $self        = shift;
	my ($vg, $pv)   = (shift, shift);
	croak "Pass values for Volume Group\n" unless $vg;
	croak "Pass values for Physical Volume Group\n" unless $pv;
	exists $self->{$vg}->{pvol}->{$pv}->{PV_LV_CMD_OUT}? $self->{$vg}->{pvol}->{$pv}->{PV_LV_CMD_OUT} : undef;
}


sub get_LV_logical_command
{
	my $self        = shift;
	my ($vg, $lv)   = (shift, shift);
	croak "Pass values for Volume Group\n" unless $vg;
	croak "Pass values for Logical Volume Group\n" unless $lv;
	exists $self->{$vg}->{lvol}->{$lv}->{LV_LOGICAL_CMD_OUT}? $self->{$vg}->{lvol}->{$lv}->{LV_LOGICAL_CMD_OUT} : undef;
}


sub get_LV_M_command
{
	my $self        = shift;
	my ($vg, $lv)   = (shift, shift);
	croak "Pass values for Volume Group\n" unless $vg;
	croak "Pass values for Logical Volume Group\n" unless $lv;

}


#### Private methods ####

# This subroutine is used to populate LV Values, PV Values and Properties of Volume Groups

sub _get_lv_pv_props 
{
    my $self = shift;
    my $lvg  = shift;
    croak "Logical volume group is not found\n" unless $lvg;
    my (@lv, @pv, %lvg_hash);

	croak "Error found during execution of lsvg $lvg: $prop_error\n" if $prop_error;
	$lvg_hash{prop} = $self->_parse_properties($prop, @lsvg_prop);
	return \%lvg_hash;
}

# This subroutine is used to populate LV Logical Values, LV Physical Values and Properties of Logical Volumes

sub _get_lslv_l_m_prop 
{
    my $self = shift;
	my $lv   = shift;
    croak "Logical volume is not found\n" unless $lv;
    my (@lv, @pv, %lslv);

	croak "Error found during execution of lslv $lv: $prop_error\n" if $prop_error;
	$lslv{prop} = $self->_parse_properties($prop, @lslv_prop);
	return \%lslv;    
}

# # This subroutine is used to populate PV Logical Values, PV PP Values and Properties of Physical Volumes

sub _get_lspv_l_m_prop 
{
    my $self = shift;
	my $pv   = shift;
    croak "Physical volume is not found\n" unless $pv;
    my (@lv, @pv, %lspv);

	croak "Error found during execution of lspv $pv: $prop_error\n" if $prop_error;
	$lspv{prop} = $self->_parse_properties($prop, @lspv_prop);
	return \%lspv;    
}

# This subroutine performs parsing the output of the commands for passed array values.

sub _parse_properties 
{
    my $self = shift;
	my $prop = shift;
	my @defp = @_;
    my %prop;

		}
	}
	return \%prop;
}

# This subroutine is used to execute the commands using open3 to capture Error stream.

sub _exec_open3
{
    my $self = shift;
	my ($result, $error);
    my $writer_h  = new IO::Handle;
    my $reader_h  = new IO::Handle;

    return $result, $error;
}

# Splitter based on pattern

sub _splitter 
{
    my $self           =  shift;
    my ($string, $pat) = (shift, shift);
    return split /$pat/, $string;
}

view all matches for this distribution

AIX-ODM

3 results


#======================================================================

$^O =~ /aix/i || die "This module only runs on AIX systems.\n";

sub odm_classes {
  my ${corp} = ${_[0]}?${_[0]}:'C';
  my @classes;
  my @devlist;
  my $class;
  my $devname;

    }
  }
  return %dev;
};
################################################################
sub odm_class {
  my ${corp} = ${_[0]}?${_[0]}:'C';
  return -1 if ( ${corp} ne 'C' );
  return -1 if (!${_[1]});
# Retrieve the class of a device from the ODM
  my ${devclass} = `lsdev -${corp} -r class -l ${_[1]}`;
  chomp(${devclass});
  return ${devclass};
};
################################################################
sub odm_subclass {
  my ${corp} = ${_[0]}?${_[0]}:'C';
  return -1 if ( ${corp} ne 'C' );
  return -1 if (!${_[1]});
# Retrieve the subclass of a device from the ODM
  my ${devsub} = `lsdev -${corp} -r subclass -l ${_[1]}`;
  chomp(${devsub});
  return ${devsub};
};
################################################################
sub odm_attributes {
  my @{line};
  my ${ndx};
  my ${aname};
  my %attrib;

    ${ndx} = ${ndx} + 1;
  }
  return %{attrib};
};
################################################################
sub odm_dump {
# Create a hash of devices by their associated class
  my ${corp} = ${_[0]}?${_[0]}:'C';
  my %devlist = &odm_classes(${corp});
  my %attrout;
  my %devices;
  my $ndx;
  my $subndx;
  foreach $ndx (keys %devlist) {
# create a hash of attributes associated with each device
    %{attrout} = &odm_attributes(${ndx});
# Add a hash value for 'class' and 'devname'
    ${devices{${ndx}}{'class'}} = ${devlist{${ndx}}};
    ${devices{${ndx}}{'subclass'}} = odm_subclass(${corp},${ndx});
    chomp(${devices{${ndx}}{'subclass'}});
    ${devices{${ndx}}{'devname'}} = $ndx;
    foreach ${subndx} (keys %attrout) {
      ${devices{${ndx}}{${subndx}}} = ${attrout{${subndx}}};
    }
  }
  return %devices;
}

  foreach ${attrname} ( keys %attribs ) {
    print "attribs{${attrname}} = ${attribs{${attrname}}}\n";
  }

  my ${devclass} = odm_class('C|P',${dev{'devname'});
  my ${devsubcl} = odm_subclass('C|P',${dev{'devname'});

=head1 DESCRIPTION

This module provides a Perl interface for accessing ODM information about an RS/6000 / pSeries machine running the AIX operating system.  It makes available several functions, which return hashes of values containing device information and their attr...

view all matches for this distribution

AIX-Perfstat

2 results

result -- which is what you want if an external library dependency is not
available.

=cut

sub check_lib_or_exit {
    eval 'assert_lib(@_)';
    if($@) {
        warn $@;
        exit;
    }
}

sub assert_lib {
    my %args = @_;
    my (@libs, @libpaths, @headers, @incpaths);

    # FIXME: these four just SCREAM "refactor" at me
    @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib})


    # work-a-like for Makefile.PL's LIBS and INC arguments
    if(defined($args{LIBS})) {
        foreach my $arg (split(/\s+/, $args{LIBS})) {
            die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-l/i);
            push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2);
        }
    }
    if(defined($args{INC})) {
        foreach my $arg (split(/\s+/, $args{INC})) {
            die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/);
            push @incpaths, substr($arg, 2);
        }
    }

    my @cc = _findcc();
    my @missing;


    my $miss_string = join( q{, }, map { qq{'$_'} } @missing );
    die("Can't link/include $miss_string\n") if @missing;
}

sub _cleanup_exe {
    my ($exefile) = @_;
    my $ofile = $exefile;
    $ofile =~ s/$Config{_exe}$/$Config{_o}/;
    unlink $exefile if -f $exefile;
    unlink $ofile if -f $ofile;
    unlink "$exefile\.manifest" if -f "$exefile\.manifest";
    return
}
    
sub _findcc {
    my @paths = split(/$Config{path_sep}/, $ENV{PATH});
    my @cc = split(/\s+/, $Config{cc});
    return @cc if -x $cc[0];
    foreach my $path (@paths) {
        my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe};
        return ($compiler, @cc[1 .. $#cc]) if -x $compiler;
    }
    die("Couldn't find your C compiler\n");
}

# code substantially borrowed from IPC::Run3
sub _quiet_system {
    my (@cmd) = @_;

    # save handles
    local *STDOUT_SAVE;
    local *STDERR_SAVE;

not been adequately tested.

Feedback is most welcome, including constructive criticism.
Bug reports should be made using L<http://rt.cpan.org/> or by email.

When submitting a bug report, please include the output from running:

    perl -V
    perl -MDevel::CheckLib -e0

=head1 SEE ALSO

view all matches for this distribution

AIX-SysInfo

1 match

SysInfo.pm view on Meta::CPAN

my @pconf_array;

#--------------------------------------------------------
# Simple functions to populate the hash
#--------------------------------------------------------
sub prtconf_param {
        my $param = shift @_;
        my @result = grep {/$param/} @pconf_array;
        return undef unless ( scalar @result );
        ($_ = pop @result) =~ /:\s*(.*)/;
        return $1;
}
sub get_total_ram {
        my $hash = shift @_;
        my $memory = prtconf_param( '^Memory Size:' );
        $memory =~ /(\d+)\D+/; $hash->{total_ram} = $1;
        return 1;
}
sub get_hostname {
        my $hash = shift @_;
        chomp ( $hash->{hostname} = `$UNAME -n` );
        return 1;
}
sub get_aix_version {
        my $hash = shift @_;
        chomp ( $hash->{aix_version} = `$OSLEVEL -r` );
        return 1;
}
sub get_serial_num {
        my $hash = shift @_;
        $hash->{serial_num} = prtconf_param( '^Machine Serial Number:' );
        return 1;
}
sub get_total_swap {
        my $hash = shift @_;
        my $swap = prtconf_param( 'Total Paging Space:' );
        $swap =~ /(\d+)\D+/; $hash->{total_swap} = $1;
        return 1;
}
sub get_hardware_info {
        my $hash = shift @_;
        chomp ( my $model_data = `$UNAME -M` );
        $model_data =~ /(.*),(.*)/;
        ( $hash->{sys_arch}, $hash->{model_type} ) = ( $1, $2 );
        return 1;
}
sub get_proc_data {
	my $hash = shift @_;
        $hash->{num_procs} = prtconf_param( '^Number Of Processors:' );
        my $speed = prtconf_param( '^Processor Clock Speed:' );
        $speed =~ /(\d+)\D+/; $hash->{proc_speed} = $1;
	$hash->{proc_type} = prtconf_param( '^Processor Type:' );
	return 1;
}
sub get_lpar_info {
        my $hash = shift @_;
        my $lpar = prtconf_param( '^LPAR Info:' );
        $lpar =~ /(\S+)\s+(\S+)/;
        $hash->{lpar_id} = $1;
        $hash->{lpar_name} = $2;
        return 1;
}
sub get_firmware_ver {
	my $hash = shift @_;
	$hash->{firmware_ver} = prtconf_param( '^Firmware Version:' );
	return 1;
}
sub get_kernel_type {
        my $hash = shift @_;
        $hash->{kernel_type} = prtconf_param( '^Kernel Type:' );
        return 1;
}

#-------------------------------------------------------------
# Module's function - get_sysinfo
#-------------------------------------------------------------
sub get_sysinfo {
	%sysinfo = ();
        my $s_ref = \%sysinfo;
        return () unless( $^O eq 'aix');
	return () unless ( open PCONF, "$PRTCONF |" );

view all matches for this distribution

ALBD

22 results

####################################################

# performs LBD
# input:  none
# ouptut: none, but a results file is written to disk
sub performLBD {
    my $self = shift;
    my $start; #used to record run times

    #implicit matrix ranking requires a different set of procedures
    if ($lbdOptions{'rankingProcedure'} eq 'implicitMatrix') {

#----------------------------------------------------------------------------

# performs LBD, closed discovery
# input:  none
# ouptut: none, but a results file is written to disk
sub performLBD_closedDiscovery {
    my $self = shift;
    my $start; #used to record run times

    print "Closed Discovery\n";
    print $self->_parametersToString();

# performs LBD, but using implicit matrix ranking schemes.
# Since the order of operations for those methods are slighly different
# a new method has been created.
# input:  none
# output: none, but a results file is written to disk
sub performLBD_implicitMatrixRanking {
    my $self = shift;
    my $start; #used to record run times
    print  $self->_parametersToString();
    print "In Implicit Ranking\n";

#NOTE: This function isn't really tested, and is really slow right now
# Generates precision and recall values by varying the threshold
# of the A->B ranking measure.
# input:  none
# output: none, but precision and recall values are printed to STDOUT
sub timeSlicing_generatePrecisionAndRecall_explicit {
    my $NUM_SAMPLES = 100; #TODO, read fomr file number of samples to average over for timeslicing
    my $self = shift;
    print "In timeSlicing_generatePrecisionAndRecall\n";

    my $numIntervals = 10;

# of the A->C ranking measure. Also generates precision at k, and
# mean average precision
# input:  none
# output: none, but precision, recall, precision at k, and map values
#         output to STDOUT
sub timeSlicing_generatePrecisionAndRecall_implicit {
    my $NUM_SAMPLES = 200; #TODO, read fomr file number of samples to average over for timeslicing
    my $self = shift;
    my $start; #used to record run times
    print "In timeSlicing_generatePrecisionAndRecall_implicit\n";

#        functions to grab parameters and inialize all input
##############################################################################
# method to create a new LiteratureBasedDiscovery object
# input: $optionsHashRef <- a reference to an LBD options hash
# output: a new LBD object
sub new {
    my $self = {};
    my $className = shift;
    my $optionsHashRef = shift;
    bless($self, $className);

}

# Initializes everything needed for Literature Based Discovery
# input: $optionsHashRef <- reference to LBD options hash (command line input)
# output: none, but global parameters are set
sub _initialize {
    my $self = shift;
    my $optionsHashRef = shift; 

    #initialize UMLS::Interface
    my %tHash = ();

# input: the name of a configuration file that has key fields in '<>'s, 
#        The '>' is followed directly by the value for that key, no space.
#        Each line of the file contains a new key-value pair (e.g. <key>value)
#        If no value is provided, a default value of 1 is set
# output: a hash ref to a hash containing each key value pair
sub _readConfigFile {
    my $self = shift;
    my $configFileName = shift;
    
    #read in all options from the config file
    open IN, $configFileName or die("Error: Cannot open config file: $configFileName\n");
    my %optionsHash = ();
    my $firstChar;
    while (my $line = <IN>) {
	#check if its a comment or blank line
	$firstChar = substr $line, 0, 1;
	
	if ($firstChar ne '#' && $line =~ /[^\s]+/) {
	    #line contains data, grab the key and value
	    $line =~ /<([^>]+)>([^\n]*)/;

}

# transforms the string of start cuis to an array
# input:  none
# output: an array ref of CUIs
sub _getStartCuis {
    my $self = shift;
    my @startCuis = split(',',$lbdOptions{'startCuis'});
    return \@startCuis;
}

# transforms the string of target cuis to an array
# input:  none
# output: an array ref of CUIs
sub _getTargetCuis {
    my $self = shift;
    my @targetCuis = split(',',$lbdOptions{'targetCuis'});
    return \@targetCuis;
}

# transforms the string of accept types or groups into a hash of accept TUIs
# input:  a string specifying whether linking or target types are being defined
# output: a hash of acceptable TUIs
sub _getAcceptTypes {
    my $self = shift;
    my $stepString = shift; #either 'linking' or 'target'

    #get the accept types 
    my %acceptTypes = ();

#         $ranksRef <- a reference to an array of CUIs ranked by their score
#         $printTo <- optional, outputs the $printTo top ranked terms. If not
#                     specified, all terms are output
# output: a line seperated string containing ranked terms, scores, and thier
#         preferred terms
sub _rankedTermsToString {
    my $self = shift;
    my $scoresRef = shift;
    my $ranksRef = shift;
    my $printTo = shift;

}

# converts the current objects parameters to a string
# input : none
# output: a string of parameters that were used for LBD
sub _parametersToString {
    my $self = shift;
        
    #LBD options
    my $paramsString = "Parameters:\n";
    foreach my $key (sort keys %lbdOptions) {



# returns the version currently being used
# input : none
# output: the version number being used
sub version {
    my $self = shift;
    return $VERSION;
}

##############################################################################
#        functions for debugging
##############################################################################
=comment
sub debugLBD {
    my $self = shift;
    my $startingCuisRef = shift;

    print "Starting CUIs = ".(join(',', @{$startingCuisRef}))."\n";

	print "   scores{$cui} = ${$scoresRef}{$cui}\n";
    }
    print "Ranks = ".join(',', @{$ranksRef})."\n";
}

sub _printMatrix {
    my $matrixRef = shift;
    my $matrixSize = shift;
    my $indexToCuiRef = shift;
    
    for (my $i = 0; $i < $matrixSize; $i++) {

view all matches for this distribution

ALPM

18 results

lib/ALPM.pm view on Meta::CPAN

	XSLoader::load(__PACKAGE__, $VERSION);
}

## PUBLIC METHODS ##

sub dbs
{
	my($self) = @_;
	return ($self->localdb, $self->syncdbs);
}

sub db
{
	my($self, $name) = @_;
	for my $db ($self->dbs){
		return $db if($db->name eq $name);
	}
	return undef;
}

sub search
{
	my($self, @qry) = @_;
	return map { $_->search(@qry) } $self->dbs;
}

view all matches for this distribution

AMF-Connection

9 results

examples/amfclient.pl view on Meta::CPAN

      {
        my $amf_class = $_;
        my $foo = $amf_class."::TO_JSON";

        # unbless object
        *$foo = sub {
            my $f = $_[0];

            #process_amf_object ($f, $amf_class);

            +{ %{$f} };

examples/amfclient.pl view on Meta::CPAN

    # blessed hash object to JSON array
    map
      {
        my $foo = $_."::TO_JSON";
        # unbless
        *$foo = sub {
            $_[0]->{'externalizedData'};
          }
      } (
          'flex.messaging.io.ArrayCollection'
        );

view all matches for this distribution

AMF-Perl

24 results

doc/cpu.pl view on Meta::CPAN


use AMF::Perl;

package cpuUsage;

sub new
{
    my ($proto)=@_;
    my $self={};
    bless $self, $proto;
    return $self;
}

sub getCpuUsage
{
    my $output = `uptime`;
    my @tokens = split /\s+/, $output;
    #Remove commas.
    @tokens = map {s/,//g; $_} @tokens;

view all matches for this distribution

AMPR-Rip44

3 results

lib/AMPR/Rip44.pm view on Meta::CPAN


Figure out local interface IP addresses so that routes to them can be ignored

=cut

sub fill_local_ifs() {

}

=head2 mask2prefix

Convert a netmask (in integer form) to the corresponding prefix length,
and validate it too. This is a bit ugly, optimizations are welcome.

=cut

sub mask2prefix ($) {
	my($mask) = @_; # integer

}

view all matches for this distribution

AMQP

5 results