Result:
found more than 317 distributions - search limited to the first 2001 files matching your query
( run in 1.987 )
AI-ParticleSwarmOptimization-MCE
view release on metacpan or search on metacpan
example/PSOTest-MultiCore.pl view on Meta::CPAN
my $fitValue = $pso->optimize ();
my ( $best ) = $pso->getBestParticles (1);
my ( $fit, @values ) = $pso->getParticleBestPos ($best);
my $iters = $pso->getIterationCount();
printf "Fit %.4f at (%s) after %d iterations\n", $fit, join (', ', map {sprintf '%.4f', $_} @values), $iters;
warn "\nTime: ", time - $beg, "\n\n";
#=======================================================================
exit 0;
AI-ParticleSwarmOptimization-Pmap
view release on metacpan or search on metacpan
example/PSOTest-MultiCore.pl view on Meta::CPAN
my $fitValue = $pso->optimize ();
my ( $best ) = $pso->getBestParticles (1);
my ( $fit, @values ) = $pso->getParticleBestPos ($best);
my $iters = $pso->getIterationCount();
printf "Fit %.4f at (%s) after %d iterations\n", $fit, join (', ', map {sprintf '%.4f', $_} @values), $iters;
warn "\nTime: ", time - $beg, "\n\n";
#=======================================================================
exit 0;
AI-ParticleSwarmOptimization
view release on metacpan or search on metacpan
Samples/PSOPlatTest.pl view on Meta::CPAN
my $fitValue = $pso->optimize ();
my ($best) = $pso->getBestParticles (1);
my ($fit, @values) = $pso->getParticleBestPos ($best);
my $iters = $pso->getIterationCount ();
print $pso->getSeed();
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);
AI-Pathfinding-AStar-Rectangle
view release on metacpan or search on metacpan
Benchmark/perl-vs-xs.pl view on Meta::CPAN
die;
for (0..99) {
$path = &astar( $x_start, $y_start, $x_end, $y_end );
}
print "Elapsed: ".tv_interval ( $t0 )."\n";
print "Path length: ".length($path)."\n";
# start end points
$map[ $x_start ][ $y_start ] = 3;
$map[ $x_end ][ $y_end ] = 4;
# draw path
my %vect = (
Benchmark/perl-vs-xs.pl view on Meta::CPAN
$x += $vect{$_}->[0];
$y += $vect{$_}->[1];
$map[$x][$y] = '|o';
}
printf "%02d", $_ for 0 .. WIDTH_X - 1;
print "\n";
for my $y ( 0 .. WIDTH_Y - 1 )
{
for my $x ( 0 .. WIDTH_X - 1 )
{
print $map[$x][$y] eq
'1' ? "|_" : (
$map[$x][$y] eq '0' ? "|#" : (
$map[$x][$y] eq '3' ? "|S" : (
$map[$x][$y] eq '4' ? "|E" : $map[$x][$y] ) ) );
}
print "$y\n";
}
sub astar
{
Benchmark/perl-vs-xs.pl view on Meta::CPAN
}
@open_idx = sort { ${$a->[2]} + ${$a->[3]} <=> ${$b->[2]} + ${$b->[3]} } @open_idx;
( $x, $y ) = @{ shift @open_idx };
$it++;
}
# print "Iterations: $it: $oindx\n";
my $path = "";
my %idx2path =
(
"0.-1" => 8, #|.
"1.-1" => 9, #/.
Benchmark/perl-vs-xs.pl view on Meta::CPAN
"-1.-1" => 7
);
while ( $x != $xs || $y != $ys )
{
# print "$x:$y\n";
my ($xp, $yp) = @{$r[$x][$y]};
$path = $idx2path{($x-$xp).".".($y-$yp)}.$path;
( $x, $y ) = ( $xp, $yp);
}
# print "Path: $path\n";
return $path;
}
sub calc_obstacle
{
Benchmark/perl-vs-xs.pl view on Meta::CPAN
{
for my $i ( 0 .. WIDTH_X - 1 )
{
if ( !$map[$i][$j] )
{
print " ##"
}
else
{
if ( $x == $i && $y == $j)
{
print "c";
}
elsif ( $xn == $i && $yn == $j )
{
print "n";
}
else
{
print " ";
}
printf "%02d", $g->[$i]->[$j]
}
}
print "\n";
}
<>;
}
AI-Pathfinding-AStar
view release on metacpan or search on metacpan
lib/AI/Pathfinding/AStar.pm view on Meta::CPAN
package main;
use My::Map::Package;
my $map = My::Map::Package->new or die "No map for you!";
my $path = $map->findPath($start, $target);
print join(', ', @$path), "\n";
#Or you can do it incrementally, say 3 nodes at a time
my $state = $map->findPathIncr($start, $target, undef, 3);
while ($state->{path}->[-1] ne $target) {
print join(', ', @{$state->{path}}), "\n";
$state = $map->findPathIncr($start, $target, $state, 3);
}
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-OptimizeMultiple
view release on metacpan or search on metacpan
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
PDL::MatrixOps::identity( $self->_get_num_scans() ) *
$iters_quota
)
);
# print "\$next_num_iters = $next_num_iters\n";
my $iters = $self->_scans_data()->slice(":,:,0");
my $iters_repeat =
$iters->dummy( 0, $self->_get_num_scans() )->xchg( 1, 2 )
->clump( 2 .. 3 );
# print "\$iters_repeat =", join(",",$iters_repeat->dims()), "\n";
my $next_num_iters_repeat =
$next_num_iters->dummy( 0, $self->_num_boards() )->xchg( 0, 2 );
# print "\$next_num_iters_repeat =", join(",",$next_num_iters_repeat->dims()), "\n";
# A boolean tensor of which boards were solved:
# Dimension 0 - Which scan is it. - size - _get_num_scans()
# Dimension 1 - Which scan we added the quota to
# - size - _get_num_scans()
# Dimension 2 - Which board. - size - _num_boards()
my $solved =
( $iters_repeat >= 0 ) * ( $iters_repeat < $next_num_iters_repeat );
# print "\$num_moves_repeat =", join(",",$num_moves_repeat->dims()), "\n";
my $num_moves_solved =
( $solved * $num_moves_repeat ) +
( $solved->not() * $UNSOLVED_NUM_MOVES_CONSTANT );
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
my $solved_moves_sums = _my_xchg_sum_over($minimal_with_zeroes);
my $solved_moves_counts = _my_xchg_sum_over($which_minima_are_solved);
my $solved_moves_avgs = $solved_moves_sums / $solved_moves_counts;
# print join(",", $solved_moves_avgs->minmaximum()), "\n";
my $min_avg;
( $min_avg, undef, $selected_scan_idx, undef ) =
$solved_moves_avgs->minmaximum();
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
$solved_with_which_iter->not()->andover() *
$flares_num_iters->sum()
)->sum()
);
print "Finished ", $loop_iter_num++,
" ; #Solved = $num_solved ; Iters = $total_num_iters ; Avg = $min_avg\n";
STDOUT->flush();
}
}
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
$obj->calc_meta_scan();
foreach my $scan_alloc (@{$self->chosen_scans()})
{
printf "Run %s for %d iterations.\n",
$scans[$scan_alloc->scan_idx], $scan_alloc->iters;
}
=head1 DESCRIPTION
AI-Pathfinding-SMAstar
view release on metacpan or search on metacpan
lib/AI/Pathfinding/SMAstar.pm view on Meta::CPAN
my $str = $log_function->($best);
$show_prog_func->($iteration, $num_states_in_queue, $str);
}
else{
my $str = $log_function->($best);
print "best is: " . $str_function->($best) . ", cost: " . $best->{_f_cost} . "\n";
}
#------------------------------------------------------
if($best->$goal_p()) {
lib/AI/Pathfinding/SMAstar.pm view on Meta::CPAN
}
continue {
$iteration++;
}
print "\n\nreturning unsuccessfully. iteration: $iteration\n";
return;
}
}
lib/AI/Pathfinding/SMAstar.pm view on Meta::CPAN
}
sub fp_compare {
my ($a, $b, $dp) = @_;
my $a_seq = sprintf("%.${dp}g", $a);
my $b_seq = sprintf("%.${dp}g", $b);
if($a_seq eq $b_seq){
return 0;
AI-Perceptron-Simple
view release on metacpan or search on metacpan
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
# accessing the confusion matrix
my @keys = qw( true_positive true_negative false_positive false_negative
total_entries accuracy sensitivity );
for ( @keys ) {
print $_, " => ", $c_matrix{ $_ }, "\n";
}
# output to console
$nerve->display_confusion_matrix( \%c_matrix, {
zero_as => "bad apples", # cat milk green etc.
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
@aoa = shuffle( @$aoa ); # this can only process actual array
unshift @aoa, $attrib_array_ref; # put back the headers before saving file
csv( in => \@aoa, out => $_, encoding => ":encoding(utf-8)" )
and
print "Saved shuffled data into ", basename($_), "!\n";
}
}
=head1 CREATION RELATED SUBROUTINES/METHODS
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
my $attrib = $csv->getline($data_fh);
$csv->column_names( $attrib );
# individual row
ROW: while ( my $row = $csv->getline_hr($data_fh) ) {
# print $row->{book_name}, " -> ";
# print $row->{$expected_output_header} ? "æ„æž—\n" : "é…丽优å“\n";
# calculate the output and fine tune parameters if necessary
while (1) {
my $output = _calculate_output( $self, $row );
#print "Sum = ", $output, "\n";
# $expected_output_header to be checked together over here
# if output >= threshold
# then category/result aka output is considered 1
# else output considered 0
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
# 1 1 -
if ( ($output >= $self->threshold) and ( $row->{$expected_output_header} eq 0 ) ) {
_tune( $self, $row, TUNE_DOWN );
if ( $display_stats ) {
print $row->{$identifier}, "\n";
print " -> TUNED DOWN";
print " Old sum = ", $output;
print " Threshold = ", $self->threshold;
print " New Sum = ", _calculate_output( $self, $row ), "\n";
}
} elsif ( ($output < $self->threshold) and ( $row->{$expected_output_header} eq 1 ) ) {
_tune( $self, $row, TUNE_UP );
if ( $display_stats ) {
print $row->{$identifier}, "\n";
print " -> TUNED UP";
print " Old sum = ", $output;
print " Threshold = ", $self->threshold;
print " New Sum = ", _calculate_output( $self, $row ), "\n";
}
} elsif ( ($output < $self->threshold) and ( $row->{$expected_output_header} eq 0 ) ) {
if ( $display_stats ) {
print $row->{$identifier}, "\n";
print " -> NO TUNING NEEDED";
print " Sum = ", _calculate_output( $self, $row );
print " Threshold = ", $self->threshold, "\n";
}
next ROW;
} elsif ( ($output >= $self->threshold) and ( $row->{$expected_output_header} eq 1 ) ) {
if ( $display_stats ) {
print $row->{$identifier}, "\n";
print " -> NO TUNING NEEDED";
print " Sum = ", _calculate_output( $self, $row );
print " Threshold = ", $self->threshold, "\n";
}
next ROW;
} #else { print "Something's not right\n'" }
}
}
close $data_fh;
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
if ( $tuning_status == TUNE_DOWN ) {
if ( $stimuli_hash_ref->{ $_ } ) { # must check this one, it must be 1 before we can alter the actual dendrite size in the nerve :)
$self->{ attributes_hash_ref }{ $_ } -= $self->learning_rate;
}
#print $_, ": ", $self->{ attributes_hash_ref }{ $_ }, "\n";
} elsif ( $tuning_status == TUNE_UP ) {
if ( $stimuli_hash_ref->{ $_ } ) {
$self->{ attributes_hash_ref }{ $_ } += $self->learning_rate;
}
#print $_, ": ", $self->{ attributes_hash_ref }{ $_ }, "\n";
}
}
}
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
$aoa = _fill_predicted_values( $self, $stimuli_validate, $predicted_index, $aoa );
# put back the array of headers before saving file
unshift @$aoa, $attrib_array_ref;
print "Saving data to $output_file\n";
csv( in => $aoa, out => $output_file, encoding => ":encoding(utf-8)" );
print "Done saving!\n";
}
=head2 &_fill_predicted_values ( $self, $stimuli_validate, $predicted_index, $aoa )
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
}
croak "Missing keys: @missing_keys" if @missing_keys;
#####
_print_extended_matrix ( _build_matrix( $c_matrix, $labels ) );
}
=head2 &_build_matrix ( $c_matrix, $labels )
Builds the matrix using C<Text::Matrix> module.
C<$c_matrix> and C<$labels> are the same as the ones passed to C<display_exam_results> and C<>display_confusion_matrix.
Returns a list C<( $matrix, $c_matrix )> which can directly be passed to C<_print_extended_matrix>.
=cut
sub _build_matrix {
lib/AI/Perceptron/Simple.pm view on Meta::CPAN
);
$matrix, $c_matrix;
}
=head2 &_print_extended_matrix ( $matrix, $c_matrix )
Extends and outputs the matrix on the screen.
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";
print $matrix->matrix();
print "~~" x24, "\n";
print "Total of ", $c_matrix->{ total_entries } , " entries\n";
print " Accuracy: $c_matrix->{ accuracy } %\n";
print " Sensitivity: $c_matrix->{ sensitivity } %\n";
# more stats
print " Precision: $c_matrix->{ precision } %\n" if exists $c_matrix->{ precision };
print " Specificity: $c_matrix->{ specificity } %\n" if exists $c_matrix->{ specificity };
print " F1 Score: $c_matrix->{ F1_Score } %\n" if exists $c_matrix->{ F1_Score };
print " Negative Predicted Value: $c_matrix->{ negative_predicted_value } %\n" if exists $c_matrix->{ negative_predicted_value };
print " False Negative Rate: $c_matrix->{ false_negative_rate } %\n" if exists $c_matrix->{ false_negative_rate };
print " False Positive Rate: $c_matrix->{ false_positive_rate } %\n" if exists $c_matrix->{ false_positive_rate };
print " False Discovery Rate: $c_matrix->{ false_discovery_rate } %\n" if exists $c_matrix->{ false_discovery_rate };
print " False Omission Rate: $c_matrix->{ false_omission_rate } %\n" if exists $c_matrix->{ false_omission_rate };
print " Balanced Accuracy: $c_matrix->{ balanced_accuracy } %\n" if exists $c_matrix->{ balanced_accuracy };
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.
AI-Perceptron
view release on metacpan or search on metacpan
examples/and.pl view on Meta::CPAN
use Data::Dumper;
use AI::Perceptron;
print( "Example: training a perceptron to recognize an 'AND' function.\n",
"usage: $0 [<threshold> <weight1> <weight2>]\n" );
my $p = AI::Perceptron->new
->num_inputs( 2 )
->learning_rate( 0.1 );
examples/and.pl view on Meta::CPAN
[-1 => 1, -1],
[-1 => -1, 1],
[ 1 => 1, 1],
);
print "\nBefore Training\n";
dump_perceptron( $p );
print "\nTraining...\n";
$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";
}
}
AI-PredictionClient-Alien-TensorFlowServingProtos
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
AI-PredictionClient
view release on metacpan or search on metacpan
bin/Inception.pl view on Meta::CPAN
$client->model_signature($self->model_signature);
$client->debug_verbose($self->debug_verbose);
$client->loopback($self->debug_loopback_interface);
$client->camel($self->debug_camel);
printf("Sending image %s to server at host:%s port:%s\n",
$self->image_file, $self->host, $self->port);
if ($client->call_inception($image_ref)) {
my $results_ref = $client->inception_results;
bin/Inception.pl view on Meta::CPAN
'|===========================================================================|',
'| {[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[} |',
$comments,
"'==========================================================================='";
print $results_text;
} else {
printf("Failed. Status: %s, Status Code: %s, Status Message: %s \n",
$client->status, $client->status_code, $client->status_message);
return 1;
}
return 0;
}
AI-Prolog
view release on metacpan or search on metacpan
examples/append.pl view on Meta::CPAN
my $prolog = AI::Prolog->new(<<"END_PROLOG");
append([], X, X).
append([W|X], Y, [W|Z]) :- append(X, Y, Z).
END_PROLOG
print "Appending two lists 'append([a],[b,c,d],Z).'\n";
$prolog->query('append([a],[b,c,d],Z).');
while (my $result = $prolog->results) {
print Dumper($result),"\n";
}
print "\nWhich lists appends to a known list to form another known list?\n'append(X,[b,c,d],[a,b,c,d]).'\n";
$prolog->query('append(X,[b,c,d],[a,b,c,d]).');
while (my $result = $prolog->results) {
print Dumper($result),"\n";
}
print "\nWhich lists can be appended to form a given list?\n'append(X, Y, [foo, bar, 7, baz]).'\n";
my $list = $prolog->list(qw/foo bar 7 baz/);
$prolog->query("append(X,Y,[$list]).");
while (my $result = $prolog->results) {
print Dumper($result),"\n";
}
AI-SimulatedAnnealing
view release on metacpan or search on metacpan
t/annealing_tests.t view on Meta::CPAN
die "ERROR: The input file does not contain the expected number of "
. "records.\n";
} # end unless
# Perform simulated annealing to optimize the coefficients for each of the
# four probabilities, and then print the results to the console:
for my $p (2..5) {
my $cost_function = cost_function_factory($mapped_distances[$p]);
my $optimized_coefficients;
my @number_specs;
t/annealing_tests.t view on Meta::CPAN
$optimized_coefficients = anneal(
\@number_specs, $cost_function, $CYCLES_PER_TEMPERATURE);
# Print the results for this probability to the console:
say "\nProbability: 1/$p";
printf("Coefficients: a = %1.3f; b = %1.3f; c= %1.3f\n",
$optimized_coefficients->[0],
$optimized_coefficients->[1],
$optimized_coefficients->[2]);
say "Cost: " . $cost_function->($optimized_coefficients);
} # next $p
AI-TensorFlow-Libtensorflow
view release on metacpan or search on metacpan
lib/AI/TensorFlow/Libtensorflow/Operation.pm view on Meta::CPAN
my $consumers = AI::TensorFlow::Libtensorflow::Input->_adef->create( $max_consumers );
my $count = $xs->($output, $consumers, $max_consumers);
return AI::TensorFlow::Libtensorflow::Input->_from_array( $consumers );
});
sub _data_printer {
my ($self, $ddp) = @_;
my %data = (
Name => $self->Name,
OpType => $self->OpType,
NumInputs => $self->NumInputs,
NumOutputs => $self->NumOutputs,
);
return sprintf('%s %s',
$ddp->maybe_colorize(ref $self, 'class' ),
$ddp->parse(\%data) );
}
1;
AI-Termites
view release on metacpan or search on metacpan
lib/AI/Termites.pm view on Meta::CPAN
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 {
AI-XGBoost
view release on metacpan or search on metacpan
lib/AI/XGBoost/CAPI.pm view on Meta::CPAN
the name of the file
=item silent
whether print messages during loading
=back
Returns a loaded data matrix
AIIA-GMT
view release on metacpan or search on metacpan
lib/AIIA/GMT.pm view on Meta::CPAN
use YAML;
use AIIA::GMT;
$result = &text2entity('less than 3000 words');
print Dump $result;
=head1 DESCRIPTION
AIIA::GMT is a XML-RPC client of a web-service server, AIIA gene mention tagger, which provides the service to recognize named entities in the biomedical articles.
AIS-client
view release on metacpan or search on metacpan
# but this is trumped by an Apache error message invoking RFC2068 sections 9 and 14.23
"Host: $HostName",
"User-Agent: $agent",
"Connection: close",
'','') ;
print SOCK $Query or croak "could not print to miniget socket";
join('',<SOCK>);
ENDMINIGET
@Sessions{@deletia} = ();
};
sub redirect($){
print <<EOF;
Location: $_[0]
Content-Type: text/html
<HTML><HEAD><TITLE>Relocate </TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="1;URL=$_[0]">
eval{
tie %Sessions => DirDB => "${SessionPrefix}_sessions";
};
if($@){
print <<EOF;
Content-Type: text/plain
AIS::client module was not able to open DirDB [${SessionPrefix}_sessions]
eval result:
if ($ENV{QUERY_STRING} eq 'LOGOUT'){
# eval <<'LOGOUT';
($Coo) = ($ENV{HTTP_COOKIE} =~ /${SessionPrefix}_session=(\w+)/)
and delete $Sessions{$Coo};
print <<EOF;
Set-Cookie:/${SessionPrefix}_session=
Content-Type: text/html
<html><head><title> LOGGED OUT </title></head>
<body bgcolor=ffffff>
# check for cookies
($Coo) = ($ENV{HTTP_COOKIE} =~ /${SessionPrefix}_session=(\w+)/);
if($Coo){
# print "Content-Type: text/plain\n\n";
# print "We have a cookie: $Coo\n";
# print( %{$Sessions{$Coo}});
# exit;
# Do we have an identity?
if (exists($Sessions{$Coo}->{identity}) and $Sessions{$Coo}->{identity} ne 'ERROR'){
# most of the time, this is what we are expecting
goto HAVE_ID ; # unless $Sessions{$Coo}->{identity} eq 'ERROR';
}
# ,@{$Param{XML}}
){
$AISXML =~ m#<$_>(.+)</$_>#si or next;
$aisvar{$_} = $1;
# print STDERR "ais var $_ is $1\n";
};
if ($aisvar{identity} eq 'NULL'){
redirect(
"$aisvar{aissri}add?RU=http$ssl_ext://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}$ENV{PATH_INFO}");
}else{
# in child -- write POSTdata to pipe and exit
close STDOUT;
close STDIN;
close POSTREAD;
print POSTWRITE delete $Sessions{$Coo}->{PostData};
close POSTWRITE or die "$$: Error closing POSTWRITE\n";
# exit;
#POSIX:_exit(0); # perldoc -f exit
exec '/usr/bin/true';
};
$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
$Sessions{$Coo}->{PostData} = <>;
print "Set-Cookie:/${SessionPrefix}_session=$Coo\n";
redirect "http$ssl_ext://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?AIS_INITIAL$suffix";
exit;
};
print <<EOF;
Content-Type: text/plain
internal AIS module logic error
EOF
NOCOO:
print <<EOF;
Content-Type: text/plain
Cookies appear to be disabled in your web browser.
Cookie string: $ENV{HTTP_COOKIE}
HAVE_ID:
$Sessions{$Coo}->{last_access} = time;
$Identity = $Sessions{$Coo}->{identity};
if($Identity eq 'ERROR'){
print <<EOF;
Content-type: text/plain
There was an error with the authentication layer
of this web service: $Sessions{$Coo}->{error}
exit;
};
# print STDERR "setting ",caller().'::AIS_IDENTITY', " to $Sessions{$Coo}->{identity}\n";
# $ENV{AIS_IDENTITY} = $Sessions{$Coo}->{identity};
$ENV{AIS_IDENTITY} =
${caller().'::AIS_IDENTITY'} = $Sessions{$Coo}->{identity};
tie %{caller().'::AIS_STASH'}, DirDB => ${tied(%{$Sessions{$Coo}})};
=head1 SYNOPSIS
BEGIN{umask(0077 & umask())}; # if your web server gives you a 0177 umask
use AIS::client;
print "Content-type: text/plain\n\nWelcome $AIS_IDENTITY\n";
print "this is page view number ", ++$AIS_STASH{accesses};
__END__
=head1 DESCRIPTION
The goal of AIS::client is to provide a very easy way to require an
AIX-LPP
view release on metacpan or search on metacpan
LPP/lpp_name.pm view on Meta::CPAN
sub write {
my $self = shift;
my $fh = shift;
print $fh join ' ', $self->{FORMAT}, $self->{PLATFORM}, $self->{TYPE},
$self->{NAME}, "{\n";
foreach my $fileset (keys %{$self->{FILESET}} ) {
print $fh join ' ', $self->{FILESET}{$fileset}{NAME},
$self->{FILESET}{$fileset}{VRMF},
$self->{FILESET}{$fileset}{DISK},
$self->{FILESET}{$fileset}{BOSBOOT},
$self->{FILESET}{$fileset}{CONTENT},
$self->{FILESET}{$fileset}{LANG},
$self->{FILESET}{$fileset}{DESCRIPTION}, "\n[\n";
for my $i ( 0 .. $#{$self->{FILESET}{$fileset}{REQ}} ) {
print $fh join ' ',@{${$self->{FILESET}{$fileset}{REQ}}[$i]},"\n";
}
print $fh "%\n";
foreach my $key (sort keys %{$self->{FILESET}{$fileset}{SIZEINFO}}) {
print $fh join ' ', $key,
$self->{FILESET}{$fileset}{SIZEINFO}{$key}, "\n";
}
print $fh "%\n%\n%\n%\n]\n";
}
print $fh "}";
}
1;
__END__
=head1 NAME
AIX-LVM
view release on metacpan or search on metacpan
Revision history for Perl extension AIX::LVM.
1.1 Fixed print commands and some comments
1.0 Fri Dec 31 23:21:40 2010
- original version;
AIX-ODM
view release on metacpan or search on metacpan
use AIX::ODM;
my %odm = odm_dump('C|P');
while ( ($ndx1, $lev2) = each %odm ) {
while ( ($ndx2, $val) = each %$lev2 ) {
print "odm{${ndx1}}{${ndx2}} = ${odm{${ndx1}}{${ndx2}}}\n";
}
}
my %dev = odm_classes('C|P');
foreach ${devname} ( keys %dev ) {
print "dev{${devname}} = ${dev{${devname}}}\n";
}
my %attribs = odm_attributes(${dev{'devname'}};
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'});
AIX-Perfstat
view release on metacpan or search on metacpan
example1.pl view on Meta::CPAN
use Data::Dumper;
use AIX::Perfstat;
my $cput = AIX::Perfstat::cpu_total();
print "cpu_total() ", Dumper($cput);
my $diskt = AIX::Perfstat::disk_total();
print "disk_total() ", Dumper($diskt);
my $netift = AIX::Perfstat::netinterface_total();
print "netinterface_total() ", Dumper($netift);
my $memoryt = AIX::Perfstat::memory_total();
print "memory_total() ", Dumper($memoryt);
my $num_cpus = AIX::Perfstat::cpu_count();
print "cpu_count() $num_cpus\n";
my $num_disks = AIX::Perfstat::disk_count();
print "disk_count() $num_disks\n";
my $num_netifs = AIX::Perfstat::netinterface_count();
print "netinterface_count() $num_netifs\n";
my $cpu_data = AIX::Perfstat::cpu($num_cpus);
print "cpu($num_cpus) ", Dumper($cpu_data);
my $disk_data = AIX::Perfstat::disk($num_disks);
print "disk($num_disks) ", Dumper($disk_data);
my $netif_data = AIX::Perfstat::netinterface($num_netifs);
print "netinterface($num_netifs) ", Dumper($netif_data);
AIX-SysInfo
view release on metacpan or search on metacpan
t/get_sysinfo.t view on Meta::CPAN
kernel_type
/;
ok( defined $hash{"$_"}, "$_" ) foreach @items;
print "=================================================\n";
print "$_ = $hash{$_}\n" foreach @items;
ALBD
view release on metacpan or search on metacpan
lib/ALBD.pm view on Meta::CPAN
}
if (exists $lbdOptions{'precisionAndRecall_implicit'}) {
$self->timeSlicing_generatePrecisionAndRecall_implicit();
return;
}
print "Open Discovery\n";
print $self->_parametersToString();
#Get inputs
my $startCuisRef = $self->_getStartCuis();
my $linkingAcceptTypesRef = $self->_getAcceptTypes('linking');
my $targetAcceptTypesRef = $self->_getAcceptTypes('target');
print "startCuis = ".(join(',', @{$startCuisRef}))."\n";
print "linkingAcceptTypes = ".(join(',', keys %{$linkingAcceptTypesRef}))."\n";
print "targetAcceptTypes = ".(join(',', keys %{$targetAcceptTypesRef}))."\n";
#Get the Explicit Matrix
$start = time;
my $explicitMatrixRef;
if(!defined $lbdOptions{'explicitInputFile'}) {
die ("ERROR: explicitInputFile must be defined in LBD config file\n");
}
$explicitMatrixRef = Discovery::fileToSparseMatrix($lbdOptions{'explicitInputFile'});
print "Got Explicit Matrix in ".(time() - $start)."\n";
#Get the Starting Matrix
$start = time();
my $startingMatrixRef =
Discovery::getRows($startCuisRef, $explicitMatrixRef);
print "Got Starting Matrix in ".(time() - $start)."\n";
#if using average minimum weight, grab the a->b scores
my %abPairsWithScores = ();
if ($lbdOptions{'rankingProcedure'} eq 'averageMinimumWeight'
|| $lbdOptions{'rankingProcedure'} eq 'ltc_amw') {
lib/ALBD.pm view on Meta::CPAN
#Apply Semantic Type Filter to the explicit matrix
if ((scalar keys %{$linkingAcceptTypesRef}) > 0) {
$start = time();
Filters::semanticTypeFilter_rowsAndColumns(
$explicitMatrixRef, $linkingAcceptTypesRef, $umls_interface);
print "Semantic Type Filter in ".(time() - $start)."\n";
}
#Get Implicit Connections
$start = time();
my $implicitMatrixRef;
if (defined $lbdOptions{'implicitInputFile'}) {
$implicitMatrixRef = Discovery::fileToSparseMatrix($lbdOptions{'implicitInputFile'});
} else {
$implicitMatrixRef = Discovery::findImplicit($explicitMatrixRef, $startingMatrixRef);
}
print "Got Implicit Matrix in ".(time() - $start)."\n";
#Remove Known Connections
$start = time();
$implicitMatrixRef = Discovery::removeExplicit($startingMatrixRef, $implicitMatrixRef);
print "Removed Known Connections in ".(time() - $start)."\n";
#Apply Semantic Type Filter
if ((scalar keys %{$targetAcceptTypesRef}) > 0) {
$start = time();
Filters::semanticTypeFilter_columns(
$implicitMatrixRef, $targetAcceptTypesRef, $umls_interface);
print "Semantic Type Filter in ".(time() - $start)."\n";
}
#Score Implicit Connections
$start = time();
my $scoresRef;
lib/ALBD.pm view on Meta::CPAN
} elsif ($lbdOptions{'rankingProcedure'} eq 'ltc_amw') {
$scoresRef = Rank::scoreImplicit_LTC_AMW($startingMatrixRef, $explicitMatrixRef, $implicitMatrixRef, $lbdOptions{'rankingMeasure'}, $umls_association, \%abPairsWithScores);
} else {
die ("Error: Invalid Ranking Procedure\n");
}
print "Scored in: ".(time()-$start)."\n";
#Rank Implicit Connections
$start = time();
my $ranksRef = Rank::rankDescending($scoresRef);
print "Ranked in: ".(time()-$start)."\n";
#Output The Results
open OUT, ">$lbdOptions{implicitOutputFile}"
or die "unable to open implicit ouput file: "
."$lbdOptions{implicitOutputFile}\n";
my $outputString = $self->_rankedTermsToString($scoresRef, $ranksRef);
my $paramsString = $self->_parametersToString();
print OUT $paramsString;
print OUT $outputString;
close OUT;
#Done
print "DONE!\n\n";
}
#----------------------------------------------------------------------------
# performs LBD, closed discovery
lib/ALBD.pm view on Meta::CPAN
# 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();
#Get inputs
my $startCuisRef = $self->_getStartCuis();
my $targetCuisRef = $self->_getTargetCuis();
my $linkingAcceptTypesRef = $self->_getAcceptTypes('linking');
lib/ALBD.pm view on Meta::CPAN
my $explicitMatrixRef;
if(!defined $lbdOptions{'explicitInputFile'}) {
die ("ERROR: explicitInputFile must be defined in LBD config file\n");
}
$explicitMatrixRef = Discovery::fileToSparseMatrix($lbdOptions{'explicitInputFile'});
print "Got Explicit Matrix in ".(time() - $start)."\n";
#Get the Starting Matrix
$start = time();
my $startingMatrixRef =
Discovery::getRows($startCuisRef, $explicitMatrixRef);
print "Got Starting Matrix in ".(time() - $start)."\n";
print " numRows in startMatrix = ".(scalar keys %{$startingMatrixRef})."\n";
#Apply Semantic Type Filter to the explicit matrix
if ((scalar keys %{$linkingAcceptTypesRef}) > 0) {
$start = time();
Filters::semanticTypeFilter_rowsAndColumns(
$explicitMatrixRef, $linkingAcceptTypesRef, $umls_interface);
print "Semantic Type Filter in ".(time() - $start)."\n";
}
#Get the Target Matrix
$start = time();
my $targetMatrixRef =
Discovery::getRows($targetCuisRef, $explicitMatrixRef);
print "Got Target Matrix in ".(time() - $start)."\n";
print " numRows in targetMatrix = ".(scalar keys %{$targetMatrixRef})."\n";
#find the linking terms in common for starting and target matrices
print "Finding terms in common\n";
#get starting linking terms
my %startLinks = ();
foreach my $row (keys %{$startingMatrixRef}) {
foreach my $col (keys %{${$startingMatrixRef}{$row}}) {
$startLinks{$col} = ${${$startingMatrixRef}{$row}}{$col};
}
}
print " num start links = ".(scalar keys %startLinks)."\n";
#get target linking terms
my %targetLinks = ();
foreach my $row (keys %{$targetMatrixRef}) {
foreach my $col (keys %{${$targetMatrixRef}{$row}}) {
$targetLinks{$col} = ${${$targetMatrixRef}{$row}}{$col};
}
}
print " num target links = ".(scalar keys %targetLinks)."\n";
#find linking terms in common
my %inCommon = ();
foreach my $startLink (keys %startLinks) {
if (exists $targetLinks{$startLink}) {
$inCommon{$startLink} = $startLinks{$startLink} + $targetLinks{$startLink};
}
}
print " num in common = ".(scalar keys %inCommon)."\n";
#Score and Rank
#Score the linking terms in common
my $scoresRef = \%inCommon;
#TODO score is just summed frequency right now
#Rank Implicit Connections
$start = time();
my $ranksRef = Rank::rankDescending($scoresRef);
print "Ranked in: ".(time()-$start)."\n";
#Output The Results
open OUT, ">$lbdOptions{implicitOutputFile}"
or die "unable to open implicit ouput file: "
."$lbdOptions{implicitOutputFile}\n";
my $outputString = $self->_rankedTermsToString($scoresRef, $ranksRef);
my $paramsString = $self->_parametersToString();
print OUT $paramsString;
print OUT $outputString;
print OUT "\n\n---------------------------------------\n\n";
print OUT "starting linking terms:\n";
print OUT join("\n", keys %startLinks);
print OUT "\n\n---------------------------------------\n\n";
print OUT "target linking terms:\n";
print OUT join("\n", keys %targetLinks, );
close OUT;
#Done
print "DONE!\n\n";
}
#NOTE, this is experimental code for using the implicit matrix as input
# to association measures and then rank. This provides a nice method of
# association for implicit terms, but there are implementation problems
lib/ALBD.pm view on Meta::CPAN
# 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";
#Get inputs
my $startCuisRef = $self->_getStartCuis();
my $linkingAcceptTypesRef = $self->_getAcceptTypes('linking');
my $targetAcceptTypesRef = $self->_getAcceptTypes('target');
print "startCuis = ".(join(',', @{$startCuisRef}))."\n";
print "linkingAcceptTypes = ".(join(',', keys %{$linkingAcceptTypesRef}))."\n";
print "targetAcceptTypes = ".(join(',', keys %{$targetAcceptTypesRef}))."\n";
#Score Implicit Connections
$start = time();
my $scoresRef;
$scoresRef = Rank::scoreImplicit_fromImplicitMatrix($startCuisRef, $lbdOptions{'implicitInputFile'}, $lbdOptions{rankingMeasue}, $umls_association);
print "Scored in: ".(time()-$start)."\n";
#Rank Implicit Connections
$start = time();
my $ranksRef = Rank::rankDescending($scoresRef);
print "Ranked in: ".(time()-$start)."\n";
#Output The Results
open OUT, ">$lbdOptions{implicitOutputFile}"
or die "unable to open implicit ouput file: "
."$lbdOptions{implicitOutputFile}\n";
my $outputString = $self->_rankedTermsToString($scoresRef, $ranksRef);
my $paramsString = $self->_parametersToString();
print OUT $paramsString;
print OUT $outputString;
close OUT;
#Done
print "DONE!\n\n";
}
=cut
##################################################
lib/ALBD.pm view on Meta::CPAN
#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;
#Get inputs
my $startAcceptTypesRef = $self->_getAcceptTypes('start');
lib/ALBD.pm view on Meta::CPAN
my $allPairsCount = scalar keys %{$assocScoresRef};
for (my $i = $numIntervals; $i >= 0; $i--) {
#determine the number of samples to threshold
my $numSamples = $i*($allPairsCount/$numIntervals);
print "i, numSamples/allPairsCount = $i, $numSamples/$allPairsCount\n";
#grab samples at just 10 to estimate the final point (this is what
# makes it an 11 point curve)
if ($numSamples == 0) {
$numSamples = 10;
}
lib/ALBD.pm view on Meta::CPAN
}
#calculate precision and recall
my ($precision, $recall) = TimeSlicing::calculatePrecisionRecall(
$implicitMatrixRef, $postCutoffMatrixRef);
print "precision = $precision, recall = $recall\n";
#calculate averages/min/max only for $i= $numIntervals, which is all terms
if ($i == $numIntervals) {
#average over all terms
foreach my $rowKey(keys %{$implicitMatrixRef}) {
lib/ALBD.pm view on Meta::CPAN
$trueAverage /= (scalar keys %{$implicitMatrixRef});
}
}
#output stats
print "predicted - total, min, max, average = $predictedTotal, $predictedMin, $predictedMax, $predictedAverage\n";
print "true - total, min, max, average = $trueTotal, $trueMin, $trueMax, $trueAverage\n";
}
# generates precision and recall values by varying the threshold
# of the A->C ranking measure. Also generates precision at k, and
lib/ALBD.pm view on Meta::CPAN
# 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";
#Get inputs
my $startAcceptTypesRef = $self->_getAcceptTypes('start');
my $linkingAcceptTypesRef = $self->_getAcceptTypes('linking');
my $targetAcceptTypesRef = $self->_getAcceptTypes('target');
#-----------
# Starting Matrix Creation
#-----------
#Get the Explicit Matrix
print "loading explicit\n";
my $explicitMatrixRef;
if(!defined $lbdOptions{'explicitInputFile'}) {
die ("ERROR: explicitInputFile must be defined in LBD config file\n");
}
$explicitMatrixRef = Discovery::fileToSparseMatrix($lbdOptions{'explicitInputFile'});
#create the starting matrix
print "generating starting\n";
my $startingMatrixRef
= TimeSlicing::generateStartingMatrix($explicitMatrixRef, \%lbdOptions, $startAcceptTypesRef, $NUM_SAMPLES, $umls_interface);
#----------
lib/ALBD.pm view on Meta::CPAN
# Gold Loading/Creation
#--------
#load or create the gold matrix
my $goldMatrixRef;
if (exists $lbdOptions{'goldInputFile'}) {
print "inputting gold\n";
$goldMatrixRef = Discovery::fileToSparseMatrix($lbdOptions{'goldInputFile'});
}
else {
print "loading post cutoff\n";
$goldMatrixRef = TimeSlicing::loadPostCutOffMatrix($startingMatrixRef, $explicitMatrixRef, $lbdOptions{'postCutoffFileName'});
#remove explicit knowledge from the post cutoff matrix
$goldMatrixRef = Discovery::removeExplicit($startingMatrixRef, $goldMatrixRef);
#apply a semantic type filter to the post cutoff matrix
print "applying semantic filter to post-cutoff matrix\n";
if ((scalar keys %{$targetAcceptTypesRef}) > 0) {
Filters::semanticTypeFilter_columns(
$goldMatrixRef, $targetAcceptTypesRef, $umls_interface);
}
#TODO why is the gold matrix outputting with an extra line between samples?
#output the gold matrix
if (exists $lbdOptions{'goldOutputFile'}) {
print "outputting gold\n";
Discovery::outputMatrixToFile($lbdOptions{'goldOutputFile'}, $goldMatrixRef);
}
}
#-------
lib/ALBD.pm view on Meta::CPAN
#-------
#if using average minimum weight, grab the a->b scores, #TODO this is sloppy here, but it has to be here...how to make it fit better?
my %abPairsWithScores = ();
if ($lbdOptions{'rankingProcedure'} eq 'averageMinimumWeight'
|| $lbdOptions{'rankingProcedure'} eq 'ltc_amw') {
print "getting AB scores\n";
#apply semantic type filter to columns only
if ((scalar keys %{$linkingAcceptTypesRef}) > 0) {
Filters::semanticTypeFilter_columns(
$explicitMatrixRef, $linkingAcceptTypesRef, $umls_interface);
lib/ALBD.pm view on Meta::CPAN
#------------
# Matrix Filtering/Thresholding
#------------
#load or threshold the matrix
if (exists $lbdOptions{'thresholdedMatrix'}) {
print "loading thresholded matrix\n";
$explicitMatrixRef = (); #clear (for memory)
$explicitMatrixRef = Discovery::fileToSparseMatrix($lbdOptions{'thresholdedMatrix'});
}
#else {#TODO apply a threshold}
#NOTE, we must threshold the entire matrix because that is how we are calculating association scores
#Apply Semantic Type Filter to the explicit matrix
print "applying semantic filter to explicit matrix\n";
if ((scalar keys %{$linkingAcceptTypesRef}) > 0) {
Filters::semanticTypeFilter_rowsAndColumns(
$explicitMatrixRef, $linkingAcceptTypesRef, $umls_interface);
}
lib/ALBD.pm view on Meta::CPAN
# Prediction Generation
#------------
#load or create the predictions matrix
my $predictionsMatrixRef;
if (exists $lbdOptions{'predictionsInFile'}) {
print "loading predictions\n";
$predictionsMatrixRef = Discovery::fileToSparseMatrix($lbdOptions{'predictionsInFile'});
}
else {
print "generating predictions\n";
#generate implicit knowledge
print "Squaring Matrix\n";
$predictionsMatrixRef = Discovery::findImplicit(
$explicitMatrixRef, $startingMatrixRef);
#Remove Known Connections
print "Removing Known from Predictions\n";
$predictionsMatrixRef
= Discovery::removeExplicit($startingMatrixRef, $predictionsMatrixRef);
#apply a semantic type filter to the predictions matrix
print "Applying Semantic Filter to Predictions\n";
if ((scalar keys %{$targetAcceptTypesRef}) > 0) {
Filters::semanticTypeFilter_columns(
$predictionsMatrixRef, $targetAcceptTypesRef, $umls_interface);
}
#save the implicit knowledge matrix to file
if (exists ($lbdOptions{'predictionsOutFile'})) {
print "outputting predictions\n";
Discovery::outputMatrixToFile($lbdOptions{'predictionsOutFile'}, $predictionsMatrixRef);
}
}
#-------------------------------------------
lib/ALBD.pm view on Meta::CPAN
#get the scores and ranks seperately for each row
# thereby generating scores and ranks for each starting
# term individually
my %rowRanks = ();
my ($n1pRef, $np1Ref, $npp);
print "getting row ranks\n";
foreach my $rowKey (keys %{$predictionsMatrixRef}) {
#grab rows from start and implicit matrices
my %startingRow = ();
$startingRow{$rowKey} = ${$startingMatrixRef}{$rowKey};
my %implicitRow = ();
lib/ALBD.pm view on Meta::CPAN
#line contains data, grab the key and value
$line =~ /<([^>]+)>([^\n]*)/;
#make sure the data was read in correctly
if (!$1) {
print STDERR
"Warning: Invalid line in $configFileName: $line\n";
}
else {
#data was grabbed from the line, add to hash
if ($2) {
lib/ALBD.pm view on Meta::CPAN
# function to produce output
##############################################################################
# outputs the implicit terms to string
# input: $scoresRef <- a reference to a hash of scores (hash{CUI}=score)
# $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;
#set printTo
if (!$printTo) {
$printTo = scalar @{$ranksRef};
}
#construct the output string
my $string = '';
my $index;
for (my $i = 0; $i < $printTo; $i++) {
#add the rank
$index = $i+1;
$string .= "$index\t";
#add the score
$string .= sprintf "%.5f\t", "${$scoresRef}{${$ranksRef}[$i]}\t";
#add the CUI
$string .= "${$ranksRef}[$i]\t";
#add the name
my $name = $umls_interface->getPreferredTerm(${$ranksRef}[$i]);
#if no preferred name, get anything
lib/ALBD.pm view on Meta::CPAN
=comment
sub debugLBD {
my $self = shift;
my $startingCuisRef = shift;
print "Starting CUIs = ".(join(',', @{$startingCuisRef}))."\n";
#Get the Explicit Matrix
my ($explicitMatrixRef, $cuiToIndexRef, $indexToCuiRef, $matrixSize) =
Discovery::tableToSparseMatrix('N_11', $cuiFinder);
print "Explicit Matrix:\n";
_printMatrix($explicitMatrixRef, $matrixSize, $indexToCuiRef);
print "-----------------------\n";
#Get the Starting Matrix
my $startingMatrixRef =
Discovery::getRows($startingCuisRef, $explicitMatrixRef);
print "Starting Matrix:\n";
_printMatrix($startingMatrixRef, $matrixSize, $indexToCuiRef);
print "-----------------------\n";
#Get Implicit Connections
my $implicitMatrixRef
= Discovery::findImplicit($explicitMatrixRef, $startingMatrixRef,
$indexToCuiRef, $matrixSize);
print "Implicit Matrix:\n";
_printMatrix($implicitMatrixRef, $matrixSize, $indexToCuiRef);
print "-----------------------\n";
#Remove Known Connections
$implicitMatrixRef = Discovery::removeExplicit($explicitMatrixRef,
$implicitMatrixRef);
print "Implicit Matrix with Explicit Removed\n";
_printMatrix($implicitMatrixRef, $matrixSize, $indexToCuiRef);
print "-----------------------\n";
print "\n\n";
#Test N11, N1P, etc...
#NOTE...always do n11 first, if n11 = -1, no need to compute the others...there is no co-occurrence between them
my $n11 = Rank::getN11('C0','C2',$explicitMatrixRef);
my $npp = Rank::getNPP($explicitMatrixRef);
my $n1p = Rank::getN1P('C0', $explicitMatrixRef);
my $np1 = Rank::getNP1('C2', $explicitMatrixRef);
print "Contingency Table Values from Explicit Matrix\n";
print "n11 = $n11\n";
print "npp = $npp\n";
print "n1p = $n1p\n";
print "np1 = $np1\n";
#Test other rank methods
my $scoresRef = Rank::scoreImplicit_fromAllPairs($startingMatrixRef, $explicitMatrixRef, $implicitMatrixRef, $lbdOptions{rankingMethod}, $umls_association);
my $ranksRef = Rank::rankDescending($scoresRef);
print "Scores: \n";
foreach my $cui (keys %{$scoresRef}) {
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++) {
my $index1 = ${$indexToCuiRef}{$i};
for (my $j = 0; $j < $matrixSize; $j++) {
my $printed = 0;
my $index2 = ${$indexToCuiRef}{$j};
my $hash1Ref = ${$matrixRef}{$index1};
if (defined $hash1Ref) {
my $val = ${$hash1Ref}{$index2};
if (defined $val) {
print $val."\t";
$printed = 1;
}
}
if (!$printed) {
print "0\t";
}
}
print "\n";
}
}
=cut
ALPM
view release on metacpan or search on metacpan
lib/ALPM/Conf.pm view on Meta::CPAN
_parse($self->{'path'}, \%hooks);
return _applyopts(\%opts, \@dbs);
}
## Import magic used for quick scripting.
# e.g: perl -MALPM::Conf=/etc/pacman.conf -le 'print $alpm->root'
sub import
{
my($pkg, $path) = @_;
my($dest) = caller;
AMF-Connection
view release on metacpan or search on metacpan
examples/amfclient.pl view on Meta::CPAN
$json->allow_blessed(1);
$json->convert_blessed(1);
my $json_data = $json->encode( $response->getData );
if ( $response->is_success ) {
print $json_data;
} else {
die "Can not send remote request for $service.$method method with params on $endpoint using AMF".$client->getEncoding()." encoding:\n".$json_data."\n";
};
AMF-Perl
view release on metacpan or search on metacpan
lib/AMF/Perl.pm view on Meta::CPAN
=head2 Sun Jun 20 13:32:31 EDT 2004
=over 4
=item Made printing output a separate function, requested by Scott Penrose.
=item Wrote exportable amf_throw() for exception handling.
=back
lib/AMF/Perl.pm view on Meta::CPAN
=head2 Wed Apr 23 19:22:56 EDT 2003
=over 4
=item Added "binmode STDOUT" before printing headers to prevent conversion of 0a to 0d0a on Windows.
=item Added modperl 1 support and (so far commented out) hypothetical modperl 2 support.
=back
lib/AMF/Perl.pm view on Meta::CPAN
#$r->header_out("Content-Length", $resLength);
#$r->send_http_header("application/x-amf");
$r->content_type("application/x-amf");
$r->headers_out->{'Content-Length'} = $resLength;
$r->send_http_header unless $MP2;
$r->print($response);
}
else
{
print <<EOF;
Content-Type: application/x-amf
Content-Length: $resLength
$response
EOF
lib/AMF/Perl.pm view on Meta::CPAN
{
$self->{exec}->setBaseClassPath($path);
}
else
{
print STDERR "Directory $path does not exist and could not be registered.\n";
die;
}
}
sub registerService
lib/AMF/Perl.pm view on Meta::CPAN
sub setSafeExecution
{
my ($self, $safe) = @_;
print STDERR "There is no need to call setSafeExecution anymore!\n";
}
sub encoding
{
my $self = shift;
lib/AMF/Perl.pm view on Meta::CPAN
if (!open(HANDLE, "> $filepath"))
{
die "Could not open file $filepath: $!\n";
}
# write to the file
if (!print HANDLE $data)
{
die "Could not print to file $filepath: $!\n";
}
# close the file resource
close HANDLE;
}
lib/AMF/Perl.pm view on Meta::CPAN
if (!open (HANDLE, ">>$filepath"))
{
die "Could not open file $filepath: $!\n";
}
# write to the file
if (!print HANDLE $data)
{
die "Could not print to file $filepath: $!\n";
}
# close the file resource
close HANDLE;
}
AMPR-Rip44
view release on metacpan or search on metacpan
sub HELP_MESSAGE()
{
my($fh) = @_;
print $fh "Usage:\n"
. " $me [-v] [-d] [-i <tunnelif>] [-a <localaddrs>] [-p <password>]\n"
. "Options:\n"
. " -v increase verbosity slightly to print error messages on stderr\n"
. " -d increase verbosity greatly (debug mode)\n"
. " -i <tunnelinterface>\n"
. " use the specified tunnel interface, defaults to tunl0\n"
. " -a <comma-separated-ip-list>\n"
. " ignore routes pointing to these (local) gateways\n"
sub VERSION_MESSAGE()
{
my($fh) = @_;
print $fh "$me version $VERSION\n";
}
# Figure out local interface IP addresses so that routes to them can be ignored
sub fill_local_ifs()
return (0, 'prefix length too short');
}
# the network-netmask pair makes sense: network & netmask == network
if (($e_net_i & $e_netmask) != $e_net_i) {
#print "e_net '$e_net_i' e_netmask '$e_netmask' ANDs to " . ($e_net_i & $e_netmask) . "\n";
warn "$e_net_s/$e_netmask_s => $e_nexthop_s blocked, subnet-netmask pair does not make sense\n" if ($verbose);
return (0, 'invalid subnet-netmask pair');
}
# network is in 44/8
AMQP
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
ANSI-Heatmap
view release on metacpan or search on metacpan
examples/boxes.pl view on Meta::CPAN
(map { [$_, 1], [$_, $y] } (1..$x)),
);
for my $c (@white) {
$map->set(@$c, 100);
}
print "$x x $y\n";
print $map, "\n";
}
}
( run in 1.987 second using v1.01-cache-2.11-cpan-de7293f3b23 )