sub\s results from the CPAN

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

4 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!";

view all matches for this distribution

AI-Pathfinding-OptimizeMultiple

12 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;

view all matches for this distribution

AI-Pathfinding-SMAstar

10 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){

		    
		    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){

}    




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);

view all matches for this distribution

AI-Perceptron-Simple

7 results


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 };


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 ) {


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


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 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;


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;


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";

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;


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;


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;


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;

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

3 results

Makefile.PL view on Meta::CPAN

  unless eval { ExtUtils::MakeMaker->VERSION(6.52) };

WriteMakefile(%WriteMakefileArgs);

# BEGIN code inserted by Dist::Zilla::Plugin::AlienBuild
sub MY::postamble {
  $abmm->mm_postamble;
}
# END code inserted by Dist::Zilla::Plugin::AlienBuild

view all matches for this distribution

AI-PredictionClient

8 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

27 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

2 results

lib/AI/SimulatedAnnealing.pm view on Meta::CPAN

# 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;

lib/AI/SimulatedAnnealing.pm view on Meta::CPAN

# (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;

lib/AI/SimulatedAnnealing.pm view on Meta::CPAN

# 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"};

view all matches for this distribution

AI-TensorFlow-Libtensorflow

78 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];

view all matches for this distribution

AI-XGBoost

5 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

	        #
	        # 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;

view all matches for this distribution

AIX-LPP

1 match

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);

	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);

	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);

	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

1 match

ODM.pm view on Meta::CPAN


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

$^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;

ODM.pm view on Meta::CPAN

    }
  }
  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;

ODM.pm view on Meta::CPAN

    ${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;

view all matches for this distribution

AIX-Perfstat

2 results

inc/Devel/CheckLib.pm view on Meta::CPAN

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})

inc/Devel/CheckLib.pm view on Meta::CPAN


    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};

inc/Devel/CheckLib.pm view on Meta::CPAN

    }
    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;

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

18 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");

}

# 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

13 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

21 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

3 results

lib/AMQP.pm view on Meta::CPAN

package AMQP;
our $VERSION = '0.01';

use Mojo::Base -base;

sub server {
	my ($self,$url) = @_;
	$url ||= '';			# incase we don't pass a url
	$url =~ /amqp:\/\/
		(?<username>[^:]+):
		(?<password>[^@]+)@

view all matches for this distribution

ANSI-Heatmap

2 results

    'blue-red'  => [0x10 .. 0x15, 0x39, 0x5d, 0x81, 0xa5, reverse(0xc4 .. 0xc9)],
    'grayscale' => [0xe8 .. 0xff],
);
my $DEFAULT_SWATCH = 'blue-red';

sub new {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    my $self = bless { map => [], minmax => {} }, $class;
    $self->swatch($DEFAULT_SWATCH);
    $self->interpolate(0);

        croak "Invalid constructor argument(s) " . join(', ', sort keys %args);
    }
    return $self;
}

sub swatch_names {
    my $self = shift;
    return (sort keys %SWATCHES);
}

sub set {
    my ($self, $x, $y, $z) = @_;
    $self->{map}[$y][$x] = $z;
    $self->_set_minmax(x => $x, y => $y, z => $z);
}

sub get {
    my ($self, $x, $y) = @_;
    return $self->{map}[$y][$x] || 0;
}

sub inc {
    my ($self, $x, $y) = @_;
    $self->set( $x, $y, $self->get($x, $y) + 1 );
}

sub swatch {
    my $self = shift;
    if (@_) {
        my $sw = shift;
        @_ == 0 or croak "swatch: excess arguments";
        if (ref $sw) {

        }
    }
    return $self->{swatch};
}

sub to_string {
    my $self = shift;
    return $self->render($self->data);
}

# Convert heatmap hash to a 2D grid of intensities, normalised between 0 and 1,
# cropped to the min/max range supplied and scaled to the desired width/height.
sub data {
    my ($self, $mm) = @_;
    my %mm = $self->_figure_out_min_and_max;
    my $inv_max_z = $mm{zrange} ? 1 / $mm{zrange} : 0;
    my @out;

    my $xscale = $mm{width} / ($mm{max_x} - $mm{min_x} + 1);
    my $yscale = $mm{height} / ($mm{max_y} - $mm{min_y} + 1);
    my $get = sub { $self->{map}[ $_[1] ][ $_[0] ] || 0 };
    my $sample;
    if (!$self->interpolate
        || $xscale == int($xscale) && $yscale == int($yscale)) {
        $sample = $get;  # nearest neighbour/direct lookup
    }

    }

    return \@out;
}

sub render {
    my ($self, $matrix) = @_;
    my $half = $self->half;

    my @s;
    for my $y (0..$#{$matrix}) {

    return join '', @s;
}


# Return hash of min/max values for each axis.
sub _figure_out_min_and_max {
    my $self = shift;
    my %calc = (
        (map { $_ => 0 } @_minmax_fields),
        %{$self->{minmax}},
        ($self->{minmax}{min_z}||0) >= 0 ? (min_z => 0) : (),

    $calc{zrange} = $calc{max_z} - $calc{min_z};

    return %calc;
}

sub _binterp {
    my $get = shift;
    return sub {
        my ($x, $y) = @_;
        my ($fx, $bx) = modf($x);
        my ($fy, $by) = modf($y);
        my @p = map { $get->($bx + $_->[0], $by + $_->[1]) } ([0,0],[0,1],[1,0],[1,1]);

        my $z = $y1 + ($y2 - $y1) * $fx;
        return $z;
    };
}

sub _set_minmax {
    my ($self, %vals) = @_;
    my $mm = $self->{minmax};
    while (my ($k, $v) = each %vals) {
        if (!defined $mm->{"min_$k"}) {
            $mm->{"min_$k"} = $mm->{"max_$k"} = $v;

        }
    }
}

# Maps a number from [0,1] to a swatch colour.
sub _swatch_lookup {
    my ($self, $index) = @_;
    return $self->{swatch}->[$index * $#{$self->{swatch}} + .5];
}

1;

view all matches for this distribution

ANSI-Palette

2 results

lib/ANSI/Palette.pm view on Meta::CPAN

	background_italic_16 => [qw/all background_italic ansi_16/],
	background_italic_256 => [qw/all background_italic ansi_256/],
);


sub palette_8 {
	print "ANSI palette -> \\e[Nm\n";
	for (30..37) {
		print "\e[" . $_ . "m " . $_;
	}
	reset;
}

sub palette_16 {
	print "ANSI palette -> \\e[Nm\n";
	for (30..37) {
		print "\e[" . $_ . "m " . $_;
	}
	print "\nANSI palette -> \\e[N;1m\n";

lib/ANSI/Palette.pm view on Meta::CPAN

		print "\e[" . $_ . ";1m " . $_;
	}
	reset;
}

sub palette_256 {
	print "ANSI palette -> \\e[38;5;Nm\n";
	for my $i (0..15) {
		for my $j (0..16) {
			my $code = $i * 16 + $j;
			print "\e[38;5;" . $code . "m " . $code;

lib/ANSI/Palette.pm view on Meta::CPAN

		print "\n";
	}
	reset;
}

sub text_8 {
	print "\e[" . $_[0] . "m" . $_[1];
	reset();
}

sub text_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : "") . "m" . $_[2];
	reset();
}

sub text_256 {
	print "\e[38;5;" . $_[0] . "m" . $_[1];
	reset();
}

sub bold_8 {
	print "\e[" . $_[0] . ";1m" . $_[1];
	reset();
}

sub bold_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";1m" . $_[2];
	reset();
}

sub bold_256 {
	print "\e[38;5;" . $_[0] . ";1m" . $_[1];
	reset();
}

sub underline_8 {
	print "\e[" . $_[0] . ";4m" . $_[1];
	reset();
}

sub underline_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : "") . ";4m" . $_[2];
	reset();
}

sub underline_256 {
	print "\e[38;5;" . $_[0] . ";4m" . $_[1];
	reset();
}

sub italic_8 {
	print "\e[" . $_[0] . ";3m" . $_[1];
	reset();
}

sub italic_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : "") . ";3m" . $_[2];
	reset();
}

sub italic_256 {
	print "\e[38;5;" . $_[0] . ";3m" . $_[1];
	reset();
}

sub background_text_8 {
	print "\e[" . $_[0] . ";" . $_[1] . "m" . $_[2];
	reset();
}

sub background_text_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";" . $_[2] . "m" . $_[3];
	reset();
}

sub background_text_256 {
	print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . "m" . $_[2];
	reset();
}

sub background_bold_8 {
	print "\e[" . $_[0] . ";" . $_[1] . ";1m" . $_[2];
	reset();
}

sub background_bold_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";" . $_[2] . ";1m" . $_[3];
	reset();
}

sub background_bold_256 {
	print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . ";1m" . $_[2];
	reset();
}

sub background_underline_8 {
	print "\e[" . $_[0] . ";" . $_[1] . ";4m" . $_[2];
	reset();
}

sub background_underline_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ';' . $_[2] . ";4m" . $_[3];
	reset();
}

sub background_underline_256 {
	print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . ";4m" . $_[2];
	reset();
}

sub background_italic_8 {
	print "\e[" . $_[0] . ";" . $_[1] . ";3m" . $_[2];
	reset();
}

sub background_italic_16 {
	print "\e[" . $_[0] . ($_[1] ? ";1" : ";0") . ";" . $_[2] . ";3m" . $_[3];
	reset();
}

sub background_italic_256 {
	print "\e[48;5;" . $_[0] . ";38;5;" . $_[1] . ";3m" . $_[2];
	reset();
}

sub reset { print "\e[0m"; }

__END__

1;

view all matches for this distribution

AOL-TOC

7 results

$SFLAP_DATA      = 2;
$SFLAP_ERROR     = 3;
$SFLAP_SIGNOFF   = 4;
$SFLAP_KEEPALIVE = 5;

sub register_callback {
  my ($self, $chan, $func, @args) = @_;

  #print "register_callback() func $func for chan $chan adding to $self->{callback}{$chan}\n";
  #print "                    self $self selfcb = $self->{callback}\n";

  @{$self->{callback}{$func}} = @args;

  return;
}

sub clear_callbacks {
  my ($self) = @_;
  my $k;

  print "...............C SFLAP clear_callbacks\n";
  for $k (keys %{$self->{callback}}) {

    print ".............S Scan key ($k)\n";
  }

}

sub callback {
  my ($self, $chan, @args) = @_;
  my $func;

  for $func (@{$self->{callback}{$chan}}) {
    #print ("callback() calling a func $func for $chan fd $self->{fd}..\n");

  }

  return;
}

sub new {
  my ($tochost, $authorizer, $port, $nickname) = @_;
  my $self;
  my $ipaddr;

  if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }

  bless($self);

  return $self;
}

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

  print "sflap destroy\n";
  CORE::close($self->{fd});

  $self = undef;

  return;
}

sub close {
  my ($self) = @_;
  my $k;

  print "sflap close\n";

  #CORE::close($self->{fd});

  return;
}

sub set_debug {
  my ($self, $level) = @_;

  $self->{debug_level} = $level;
  print "slfap debug level $level\n";
}

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

  if (exists $self->{debug_level} && $self->{debug_level} > 0) {
    print @args;
  }
}

sub __connect {
  my ($self) = @_;
  my $socksaddr = inet_aton("206.223.45.1");

  my $proto = getprotobyname('tcp');
  my $sin   = sockaddr_in(1080, $socksaddr);

  syswrite($fd, $buffer, 19);

  return ($fd);
}

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

  my $proto = getprotobyname('tcp');
  my $sin   = sockaddr_in($self->{port}, $self->{ipaddr});
  my $fd    = IO::Handle->new();

  connect($fd, $sin) || die "connect: $!";

  return ($fd);
}

sub connect {
  my ($self) = @_;
  my $fd;

  if ($self->{proxy}) {
    $fd = &{$self->{proxy}};

  $self->recv();

  return $fd;
}

sub recv {
  my ($self) = @_;
  my ($buffer, $from, $xfrom) = '';
  my ($fd) = $self->{fd};

  $foo = CORE::sysread($fd, $buffer, 6);

  $self->callback($chan, $data);

  return $buffer;
}

sub send {
  my ($self, $chan, $data, $length) = @_;
  my $buffer;
  my $format;

  if (!$length) {