view release on metacpan or  search on metacpan

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

    my($delimiter, $keep, $line) = @_;
    my($word, @pieces);

    no warnings 'uninitialized';  # we will be testing undef strings

    while (length($line)) {
        # This pattern is optimised to be stack conservative on older perls.
        # Do not refactor without being careful and testing it on very long strings.
        # See Perl bug #42980 for an example of a stack busting input.
        $line =~ s/^
                    (?:

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

                            (?!^)(?=["'])               # a quote
                        )
        )//xs or return;    # extended layout
        my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);

        return() unless( defined($quote) || length($unquoted) || length($delim));

        if ($keep) {
            $quoted = "$quote$quoted$quote";
        }
        else {

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

            }
        }
        $word .= substr($line, 0, 0); # leave results tainted
        $word .= defined $quote ? $quoted : $unquoted;

        if (length($delim)) {
            push(@pieces, $word);
            push(@pieces, $delim) if ($keep eq 'delimiters');
            undef $word;
        }
        if (!length($line)) {
            push(@pieces, $word);
        }
    }
    return(@pieces);
}

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

    my $Config_ccflags =  $Config{ccflags};  # use copy so ASPerl will compile
    my @Config_ldflags = ();
    for my $config_val ( @Config{qw(ldflags)} ){
        push @Config_ldflags, $config_val if ( $config_val =~ /\S/ );
    }
    my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||'', $user_ccflags||'');
    my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags, $user_ldflags||'');
    my @paths = split(/$Config{path_sep}/, $ENV{PATH});
    my @cc = split(/\s+/, $Config{cc});
    if (check_compiler ($cc[0], $debug)) {
	return ( [ @cc, @ccflags ], \@ldflags );
    }

 view release on metacpan or  search on metacpan

lib/AAC/Pvoice/Panel.pm  view on Meta::CPAN

		       $self->{itemspacing});  # padding
	$self->{tls}->Add($rowsizer, 0, wxALIGN_CENTRE, 0);
	$self->{textrowsizer} = $rowsizer;
    
	$self->{text}->SetValue(my $x = $self->RetrieveText);
	$self->{text}->SetStyle(0, length($self->{text}->GetValue), $self->{ta});
	$self->{text}->Refresh(); # Added to test it on the Mercury...added text
				  # isn't visible there...
    }    
    $self->{title}->SetBackgroundColour($self->BackgroundColour) unless $self->{disabletitle};

lib/AAC/Pvoice/Panel.pm  view on Meta::CPAN

{
    my $self = shift;
    pop @{$self->{displaytextsave}};
    pop @{$self->{speechtextsave}};
    $self->{text}->SetValue(my $x = $self->RetrieveText);
    $self->{text}->SetStyle(0, length($self->{text}->GetValue), $self->{ta});
    $self->{text}->Refresh(); # Added to test it on the Mercury...added text
                              # isn't visible there...
}

sub SpeechRetrieveText

 view release on metacpan or  search on metacpan

ABI.pm  view on Meta::CPAN

	$self->{T}                     = [];
	$self->{G}                     = [];
	$self->{C}                     = [];
	$self->{_basecalls}            = [];
	$self->{_basecalls_corrected}  = [];
	$self->{_trace_length}         = 0;
	$self->{_seq_length}           = 0;
	$self->{_seq_length_corrected} = 0;
	$self->{_abs_index}            = 26;
	$self->{_index}                = undef;
	$self->{PLOC1}                 = undef;
	$self->{PLOC}                  = undef;
	$self->{_a_start}              = undef;

ABI.pm  view on Meta::CPAN

			$self->{SMPL} = $self->{_index} + ( $i * 28 ) + 20;
		}
	}
	seek( $self->{_fh}, $self->{DATA12} - 8, 0 );
	read( $self->{_fh}, $buf, 4 );
	$self->{_trace_length} = unpack( "N", $buf );
	seek( $self->{_fh}, $self->{PBAS2} - 4, 0 );
	read( $self->{_fh}, $buf, 4 );
	$self->{_seq_length} = unpack( "N", $buf );
	seek( $self->{_fh}, $self->{PBAS1} - 4, 0 );
	read( $self->{_fh}, $buf, 4 );
	$self->{_seq_length_corrected} = unpack( "N", $buf );
	$self->{PLOC}   = $self->_get_int( $self->{PLOC} ) + $self->{_mac_header};
	$self->{PLOC1}  = $self->_get_int( $self->{PLOC1} ) + $self->{_mac_header};
	$self->{DATA9}  = $self->_get_int( $self->{DATA9} ) + $self->{_mac_header};
	$self->{DATA10} = $self->_get_int( $self->{DATA10} ) + $self->{_mac_header};
	$self->{DATA11} = $self->_get_int( $self->{DATA11} ) + $self->{_mac_header};

ABI.pm  view on Meta::CPAN

}

sub _set_base_calls {
	my $self = shift;
	my $buf;
	my $length = $self->{_seq_length} * 2;
	my $fh     = $self->{_fh};
	seek( $fh, $self->{PLOC}, 0 );
	read( $fh, $buf, $length );
	@{ $self->{_basecalls} } = unpack( "n" x $length, $buf );

	# print "@{$self->{_basecalls}}" , "\n";
}

sub _set_corrected_base_calls {
	my $self = shift;
	my $buf;
	my $length = $self->{_seq_length_corrected} * 2;
	my $fh     = $self->{_fh};
	seek( $fh, $self->{PLOC1}, 0 );
	read( $fh, $buf, $length );
	@{ $self->{_basecalls_corrected} } = unpack( "n" x $length, $buf );
}

sub _set_seq {
	my $self = shift;
	my $buf;
	my $length = $self->{_seq_length};
	my $fh     = $self->{_fh};
	seek( $fh, $self->{PBAS2}, 0 );
	read( $fh, $buf, $length );
	$self->{_sequence} = $buf;

	#my @seq = unpack( "C" x $length, $buf);
	#print $buf, "\n";
}

sub _set_corrected_seq {
	my $self = shift;
	my $buf;
	my $length = $self->{_seq_length_corrected};
	my $fh     = $self->{_fh};
	seek( $fh, $self->{PBAS1}, 0 );
	read( $fh, $buf, $length );
	$self->{_sequence_corrected} = $buf;
}

sub _set_traces {
	my $self = shift;

ABI.pm  view on Meta::CPAN

			croak "Wrong traces\n";
		}
	}
	for ( my $i = 0 ; $i < 4 ; $i++ ) {
		seek( $fh, $pointers[$i], 0 );
		read( $fh, $buf, $self->{_trace_length} * 2 );
		if ( $i == 0 ) {
			@A = unpack( "n" x $self->{_trace_length}, $buf );
		}
		if ( $i == 1 ) {
			@C = unpack( "n" x $self->{_trace_length}, $buf );
		}
		if ( $i == 2 ) {
			@G = unpack( "n" x $self->{_trace_length}, $buf );
		}
		if ( $i == 3 ) {
			@T = unpack( "n" x $self->{_trace_length}, $buf );
		}
	}
	@{ $self->{A} } = @A;
	@{ $self->{G} } = @G;
	@{ $self->{T} } = @T;

ABI.pm  view on Meta::CPAN

	my $self = shift;
	my $buf;
	my $fh = $self->{_fh};
	seek( $fh, $self->{SMPL}, 0 );
	read( $fh, $buf, 1 );
	my $length = unpack( "C", $buf );
	read( $fh, $buf, $length );
	$self->{_sample} = $buf;
}

=head1 METHODS

ABI.pm  view on Meta::CPAN

sub get_corrected_sequence {
	my $self = shift;
	return $self->{_sequence_corrected};
}

=head2 get_sequence_length()

  Title    : get_sequence_length()
  Usage    : my $seq_length = $abi->get_sequence_length();
  Function : Returns the sequence length of the orginal unedited sequence.
  Args     : Nothing
  Returns  : A scalar

=cut

sub get_sequence_length {
	my $self = shift;
	return $self->{_seq_length};
}

=head2 get_corrected_sequence_length()

  Title    : get_corrected_sequence_length()
  Usage    : my $seq_length = $abi->get_corrected_sequence_length();
  Function : Returns the length of the edited sequence. 
  Args     : Nothing
  Returns  : A scalar

=cut

sub get_corrected_sequence_length {
	my $self = shift;

	#print STDERR "**ABI**",$self->{_seq_length_corrected},"\n";
	return $self->{_seq_length_corrected};
}

=head2 get_trace_length()

  Title    : get_trace_length()
  Usage    : my $trace_length = $abi->get_trace_length();
  Function : Returns the trace length
  Args     : Nothing
  Returns  : A scalar

=cut

sub get_trace_length {
	my $self = shift;
	return $self->{_trace_length};
}

=head2 get_base_calls()

  Title    : get_base_calls()

 view release on metacpan or  search on metacpan

lib/ABNF/Generator/Liar.pm  view on Meta::CPAN

=pod

=head1 $liar->C<endlessCommand>($name)

Return an string starts like command $name and length more then $ENDLESS = 513 * 1024 / 4

$tail is a string added to result if it absent.

dies if there is no command like $rule.

 view release on metacpan or  search on metacpan

lib/AC/DC/IO.pm  view on Meta::CPAN

sub _writable {
    my $me = shift;

    return $me->run_callback('writeable', undef) unless $me->{_wbuffer};

    my $len = length($me->{_wbuffer});
    my $bs = $me->{wbufsize} || $BUFSIZ;
    $len = $bs if $len > $bs;
    my $buf = substr($me->{_wbuffer}, 0, $len);
    my $i = syswrite( $me->{fd}, $buf );

    if( defined $i ){
        # debug("wrote $i bytes to $me->{info}");
        substr($me->{_wbuffer}, 0, $i) = '';
        if( length($me->{_wbuffer}) ){
            $me->timeout_rel( $me->{writebuf_timeout} ) if $me->{writebuf_timeout};
        }else{
            $me->wantwrite(0);
            $me->run_callback('write_buffer_empty', undef);
        }

 view release on metacpan or  search on metacpan

lib/AC/MrGamoo/API/Get.pm  view on Meta::CPAN

    my $gb  = ACPScriblReply->encode( { status_code => 200, status_message => 'OK', hash_sha1 => $sha1 } );
    my $hdr = AC::MrGamoo::Protocol->encode_header(
        type		=> $proto->{type},
        msgidno		=> $proto->{msgidno},
        is_reply	=> 1,
        data_length	=> length($gb),
        content_length	=> $size,
       );
    my $buf = $hdr . $gb;

    syswrite( $fd, $buf );

 view release on metacpan or  search on metacpan

lib/AC/Yenta/Crypto.pm  view on Meta::CPAN

    my $key    = $me->_key($seqno, $nonce);
    my $iv     = $me->_iv($key, $seqno, $nonce);

    # pad
    my $pbuf = $buf;
    $pbuf .= "\0" x (16 - length($pbuf) & 0xF) if length($pbuf) & 0xF;

    my $aes    = Crypt::Rijndael->new( $key, Crypt::Rijndael::MODE_CBC );
    $aes->set_iv( $iv );
    my $ct     = $aes->encrypt( $pbuf );
    my $hmac   = hmac_sha256_base64($ct, $key);

lib/AC/Yenta/Crypto.pm  view on Meta::CPAN

    my $eb     = ACPEncrypt->encode( {
        algorithm	=> $ALGORITHM,
        seqno		=> $seqno,
        nonce		=> $nonce,
        hmac		=> $hmac,
        length		=> length($buf),
        ciphertext	=> $ct,
    } );

    debug("encrypted <$seqno,$nonce,$hmac>");

lib/AC/Yenta/Crypto.pm  view on Meta::CPAN

    my $hmac   = hmac_sha256_base64($ed->{ciphertext}, $key);
    die "cannot decrypt: hmac mismatch\n" unless $hmac eq $ed->{hmac};

    my $aes    = Crypt::Rijndael->new( $key, Crypt::Rijndael::MODE_CBC );
    $aes->set_iv( $iv );
    my $pt     = substr($aes->decrypt( $ed->{ciphertext} ), 0, $ed->{length});

    debug("decrypted <$seqno,$nonce,$hmac>");

    return $pt;
}

 view release on metacpan or  search on metacpan

lib/ACH/Generator.pm  view on Meta::CPAN

        my $dataValue = "";

		# Get the section header in the first field, else get the data        
        if ($y == 0) { $dataValue = $sectionValue = $hash{$hashItem}; }
        else { 
          # Get the field length and data
		  my $field = ${$self->{_achFormats}{$sectionValue}}[$y];
          my ($field_length);  while ( my ($key, $value) = each(%$field) ) { $field_length = $value; }
          $dataValue = substr($hash{$hashItem}, 0, $field_length); 
        }
        
        # Store the data in the file data variable
        $data .= $dataValue;
      }

 view release on metacpan or  search on metacpan

lib/ACH/Parser.pm  view on Meta::CPAN

  my @data = <INPUT>;
  my $dataline = $data[0];
  my $pos = 0;
  
  # Loop Through all entries
  while ($pos < length($dataline)) {
    # Get the correct ACH format array and store all parsed data in a hash
    my $desc = substr($dataline, $pos, 1);
    my @dataArray = [];

    # Make sure file descriptor is valid

lib/ACH/Parser.pm  view on Meta::CPAN

    
    # Iterate through the appropriate ACH file format array and parse the data
    for (my $x=0; $x < @{$self->{_achFormats}{$desc}}; $x++) {
	  my $field = ${$self->{_achFormats}{$desc}}[$x];
            
	  # Get the field name and length
	  my ($field_name, $field_length);
	  while ( my ($key, $value) = each(%$field) ) { $field_name = $key;  $field_length = $value; }

      # Get the ACH Data from the file
      my $part = substr($dataline, $pos, $field_length);  chomp $part;
      my %hash = ($field_name => $part);
      $dataArray[$x] = \%hash;
      $pos += $field_length;    
    }
    
    # Save data to list
    @{$self->{_achData}}[scalar @{$self->{_achData}}] = \@dataArray; 
  }

 view release on metacpan or  search on metacpan

lib/ACL/Lite.pm  view on Meta::CPAN

			my @perms;

			for my $perm (split(/$self->{separator}/, $args{permissions})) {
				$perm =~ s/^\s+//;
				$perm =~ s/\s+$//;
				next unless length($perm);

				$self->{permissions}->{$perm} = 1;
			}
		}
	}

 view release on metacpan or  search on metacpan

t/00-report-prereqs.t  view on Meta::CPAN

        }

        if ( @reports ) {
            push @full_reports, "=== $title ===\n\n";

            my $ml = _max( map { length $_->[0] } @reports );
            my $wl = _max( map { length $_->[1] } @reports );
            my $hl = _max( map { length $_->[2] } @reports );

            if ($type eq 'modules') {
                splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
                push @full_reports, map { sprintf("    %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
            }

 view release on metacpan or  search on metacpan

t/00-report-prereqs.t  view on Meta::CPAN

        }

        if ( @reports ) {
            push @full_reports, "=== $title ===\n\n";

            my $ml = _max( map { length $_->[0] } @reports );
            my $wl = _max( map { length $_->[1] } @reports );
            my $hl = _max( map { length $_->[2] } @reports );

            if ($type eq 'modules') {
                splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
                push @full_reports, map { sprintf("    %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
            }

 view release on metacpan or  search on metacpan

t/data/python_quotes.txt  view on Meta::CPAN

cofounded, he also had the well- deserved reputation of being quite laconic
(this I know from personal experience ;-). Early in his career, he received an
award from some masonry organization for his use of brick in building OWP (now
OWP&P) had designed. This necessitated the usual awards ceremony with dinner
and speeches. The recipients who preceeded Ray to the podium all spoke at
length about their work. Ray's entire acceptance speech was, "The building
speaks for itself."
      -- Skip Montanaro, 4 Jan 2002

The Lisp community is like a ghost town, with the occasional banshee howl
echoing darkly around the chamber in lament of what might have been.

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

 view release on metacpan or  search on metacpan

lib/AES128.pm  view on Meta::CPAN

=head1 DESCRIPTION

Perl wrapper for the tiny-AES-c library (https://github.com/kokke/tiny-AES-c)

Since 128bit key length is secure enough for most applications and ECB is NOT secure,
this module supports 128bit key length and CTR mode only.

=head2 EXPORT

None by default.

 view release on metacpan or  search on metacpan

examples/Meltdown.pl  view on Meta::CPAN

	exit 0;
} # Usage

sub Check_data {
	#
	# If a value is going to overflow the field length,
	# then bump the field length to match the value.
	# It won't be pretty but we'll have valid data.
	#
	(length $wproc	> $Ln[0]) ? ($Ln[0] = length $wproc)	: "";
	(length $nobuf	> $Ln[1]) ? ($Ln[1] = length $nobuf)	: "";
	(length $wpack	> $Ln[2]) ? ($Ln[2] = length $wpack)	: "";
	(length $fpack	> $Ln[3]) ? ($Ln[3] = length $fpack)	: "";
	(length $calls	> $Ln[4]) ? ($Ln[4] = length $calls)	: "";
	(length $delta	> $Ln[5]) ? ($Ln[5] = length $delta)	: "";
	(length $data	> $Ln[6]) ? ($Ln[6] = length $data)	: "";
	(length $resend	> $Ln[7]) ? ($Ln[7] = length $resend)	: "";
	(length $idle	> $Ln[8]) ? ($Ln[8] = length $idle)	: "";
} # Check_data

sub Header {
    if ($csvmode != 1) {
    	print "\nhh:mm:ss wproc nobufs   wpack  fpack    calls     delta  data      resends  idle\n";

examples/Meltdown.pl  view on Meta::CPAN

$nobuf	= 0;
$idle	= 0;
$oldcall = 0;

#
# set the default field format lengths for
# wproc,nobuf,wpack,fpack,calls,delta,data,resend,idle
#
@Ln = (5,8,6,8,9,6,9,8,4);

#

examples/Meltdown.pl  view on Meta::CPAN

	$resend = $rxstats->{dataPacketsReSent};
	$nobuf = $rxstats->{noPacketBuffersOnRead};
	$idle = $tstats->{idleThreads};

	#
	# verify and fix field format lengths
	#
	Check_data;

    if ($csvmode != 1) {
    	#

 view release on metacpan or  search on metacpan

t/lib/Test/RRA.pm  view on Meta::CPAN

        $sigdie = $SIG{__DIE__} || undef;
    }

    # If the use failed for any reason, skip the test.
    if (!$result || $error) {
        my $name = length($version) > 0 ? "$module $version" : $module;
        plan skip_all => "$name required for test";
    }

    # If the module set $SIG{__DIE__}, we cleared that via local.  Restore it.
    ## no critic (Variables::RequireLocalizedPunctuationVars)

 view release on metacpan or  search on metacpan

src/ACL/ACL.pm  view on Meta::CPAN

}

# comment Roland Schemers: I hope I don't have to debug these :-)
sub empty      { $_[0] = bless [ {},{} ]; }
sub get_users  { CORE::keys %{$_[0]->[0]}; }
sub length     { int(CORE::keys %{$_[0]->[0]}); }
sub get_rights { ${$_[0]->[0]}{$_[1]}; }
sub exists     { CORE::exists ${$_[0]->[0]}{$_[1]}; }
sub set        { ${$_[0]->[0]}{$_[1]} = $_[2]; }
sub remove     { delete ${$_[0]->[0]}{$_[1]}; }
sub clear      { $_[0]->[0] = {}; }

src/ACL/ACL.pm  view on Meta::CPAN

sub del  { delete ${$_[0]->[0]}{$_[1]}; } # old form:  DEPRECATED !!!!


# comment Roland Schemers: same for negative entries
sub nget_users  { CORE::keys %{$_[0]->[1]}; }
sub nlength     { int(CORE::keys %{$_[0]->[1]}); }
sub nget_rights { ${$_[0]->[1]}{$_[1]}; }
sub nexists     { CORE::exists ${$_[0]->[1]}{$_[1]}; }
sub nset        { ${$_[0]->[1]}{$_[1]} = $_[2]; }
sub nremove     { delete ${$_[0]->[1]}{$_[1]}; }
sub nclear      { $_[0]->[1] = {}; }

 view release on metacpan or  search on metacpan

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

This module exports three functions: calibrate, score_prob and print_mapping.

=head1 BUGS

None known.  This implementation is straightforward but inefficient (its time
is O(n^2) in the length of the data series).  A linear time algorithm is
known, and in a later version of this module I'll probably implement it.

=head1 SEE ALSO

The AI::NaiveBayes1 perl module.

 view release on metacpan or  search on metacpan

lib/AI/Categorizer/Document/XML.pm  view on Meta::CPAN

sub start_element{
  my ($self, $el)= @_;

  # find the last location of the content
  # its meaning is to append the new data at this location
  my $location= length $self->{content};

  # save the last location of the current content
  # so that at end_element the starting location of data of this element can be known
  $self->{locationArray}[$self->{levelPointer}] = $location;

 view release on metacpan or  search on metacpan

lib/AI/Classifier/Text/Analyzer.pm  view on Meta::CPAN

            eval{
                my $host = $uri->host;
                $host =~ s/^www\.//;
                $features->{ lc $host }++;
                for (split /\//, $uri->path) {
                    if (length $_ > 3 ) {
                        $features->{ lc $_}++;
                    }
                }
            }
        }

lib/AI/Classifier/Text/Analyzer.pm  view on Meta::CPAN

    $p->find($text);
    my $weight = $self->global_feature_weight;
    if (!@urls) {
        $features->{NO_URLS} = $weight;
    }
    if (scalar @urls > length( $text ) / 120 ) {
        $features->{MANY_URLS} = $weight;
    }
    {
        my %urls;
        for my $url ( @urls ) {

 view release on metacpan or  search on metacpan

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

   # build request parameters
   my %ps = (
      key  => $self->key,
      user => $self->user,
   );
   $ps{nick} = $self->nick if $self->has_nick && length $self->nick;

   my $data =
     $self->_parse_response(
      $self->ua->post_form($self->endpoints->{create}, \%ps));

 view release on metacpan or  search on metacpan

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

}

sub prune_tree {
  my $self = shift;

  # We use a minimum-description-length approach.  We calculate the
  # score of each node:
  #  n = number of nodes below
  #  r = number of results (categories) in the entire tree
  #  i = number of instances in the entire tree
  #  e = number of errors below this node

  # Hypothesis description length (MML):
  #  describe tree: number of nodes + number of edges
  #  describe exceptions: num_exceptions * log2(total_num_instances) * log2(total_num_results)
  
  my $r = keys %{ $self->{results} };
  my $i = $self->{tree}{instances};

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

=item prune

A boolean C<prune> parameter which specifies
whether the tree should be pruned after training.  This is usually a
good idea, so the default is to prune.  Currently we prune using a
simple minimum-description-length criterion.

=item verbose

If set to a true value, some status information will be output while
training a decision tree.  Default is false.

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

=item depth()

Returns the depth of the tree.  This is the maximum number of
decisions that would need to be made to classify an unseen instance,
i.e. the length of the longest path from the tree's root to a leaf.  A
tree with a single node would have a depth of zero.

=item rule_tree()

Returns a data structure representing the decision tree.  For 

 view release on metacpan or  search on metacpan

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

        $self->{'error'} = 'Nothing to compare!';
        return;
    }

    if (scalar keys %$vector1 != scalar keys %$vector2) {
        $self->{'error'} = 'Embeds are unequal length';
        return;
    }

    return $self->_compare_vector($vector1, $vector2);
}

 view release on metacpan or  search on metacpan

lib/AI/Evolve/Befunge/Blueprint.pm  view on Meta::CPAN

    my $blueprint = Blueprint->new(code => $codestring, dimensions => 4);

Create a new Blueprint object.  Two attributes are mandatory:

    code - a Befunge code string.  This must be exactly the right
           length to fill a hypercube of the given dimensions.
    dimensions - The number of dimensions we will operate in.

Other arguments are optional, and will be determined automatically if
not specified:

lib/AI/Evolve/Befunge/Blueprint.pm  view on Meta::CPAN

    croak $usage unless exists $args{code};
    croak $usage unless exists $args{dimensions};
    $$self{code}      = $args{code};
    $$self{dims}      = $args{dimensions};
    if($$self{dims} > 1) {
        $$self{size}      = int((length($$self{code})+1)**(1/$$self{dims}));
    } else {
        $$self{size} = length($$self{code});
    }
    croak("code has a non-orthogonal size!")
        unless ($$self{size}**$$self{dims}) == length($$self{code});
    $$self{size}      = Language::Befunge::Vector->new(map { $$self{size} } (1..$$self{dims}));
    $$self{fitness}   = $args{fitness} // 0;
    $$self{id}        = $args{id}          if exists $args{id};
    $$self{host}      = $args{host}        if exists $args{host};
    $$self{id}        = $self->new_popid() unless defined $$self{id};

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

 view release on metacpan or  search on metacpan

bin/consult  view on Meta::CPAN

	wm deiconify .askme
	wm title .askme "What I want to know is?"

	# Set the question text

	label .askme.l -text $message -padx 10 -pady 10 -wraplength 300
	pack .askme.l -side top -anchor n

	# The is where the users choice will go
	global choice
	set choice ""

 view release on metacpan or  search on metacpan

lib/AI/FANN/Evolving/Gene.pm  view on Meta::CPAN

		# this is a number which we try to keep as near to zero
		# as possible
		my $fitness = 0;
		
		# iterate over the list of input/output pairs
		for my $i ( 0 .. ( $env->length - 1 ) ) {
			my ( $input, $expected ) = $env->data($i);
			my $observed = $ann->run($input);
			
			use Data::Dumper;
			$log->debug("Observed: ".Dumper($observed));
			$log->debug("Expected: ".Dumper($expected));
			
			# invoke the error_func provided by the experiment
			$fitness += $error_func->($observed,$expected);
		}
		$fitness /= $env->length;
		
		# store result
		$self->{'fitness'} = $fitness;

		# store the AI		

 view release on metacpan or  search on metacpan

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

=item $train->scale($new_min, $new_max)

-

=item $train->subset($pos, $length)

-

=item $train->num_inputs

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

=item $train->num_outputs

-

=item $train->length

-

=back