example_client.pl

基于稀疏网络的精选机器学习模型

#!/usr/bin/perl
# Change the line above to match the location of perl on your system.

# The PERL extension Getopt::Declare was written by Damian Conway, and is
# available at http://www.cpan.org.  Type 'perldoc Declare.pm' for more
# information.  I modified it (just slightly), and the modified version has
# been included in this directory.  Hence, the line below.  Change the path to
# the absolute path where you unpacked SNoW.
sub BEGIN { unshift @INC, "$ENV{SNOW_HOME}/tutorial"; }
use IO::Socket;

use Getopt::Declare;
# Getopt::Declare specifications include tab characters.  The statement below
# makes the usage information printed by 'example_client.pl --help' look nice.
# If your editor also has a tabstop setting, setting it to 2 will make the
# specification below look nice also.
$Text::Tabs::tabstop = 2;
$PROPER_NAME = "Example SNoW Client";
$VERSION = "1.0";


$parameters = "";
$server_name = "localhost";
die "Fatal errors encountered.  Exiting...\n" unless new Getopt::Declare q(
  [strict]
  SNoW's server mode accepts the same parameters from clients as it does on
  the command line, except for -e (eligibility), which only matters as the
  network is being read in.

  See the SNoW User's Guide or run SNoW with no command line parameters for a
  more detailed description of all these parameters.  The output of this
  script will be sent to STDOUT.

  ----------------------------------------------------------------------------
  Required options:

  -s <port:i>	            Specifies the port number at which the server is
                          listening.
                          [required]
                          { $::port = $port; }

  -I <testing_file:if>	  Specifies the file containing testing examples to be
                          sent to the server.
                          [required]
                          { $::testing_file = $testing_file; }

  ----------------------------------------------------------------------------
  Optional options that won't be sent to the server:

  -server <server_name:s>	Specifies the machine name or IP address on which
                          the server is running.  If unspecified, it defaults
                          to 'localhost'.
                          { $::server_name = $server_name; }

  ----------------------------------------------------------------------------
  Optional options that will be sent to the server:

  -b <bayes_smoothing:n>	    Specifies a smoothing parameter for Naive Bayes.
  { $::parameters .= "-b $bayes_smoothing "; }

  -f <fixed_feature:s>	      '+' enables the fixed feature; '-' disables it.
  {
    die "The argument to '-f' must be either '+' or '-'"
      if ($fixed_feature ne "+" && $fixed_feature ne "-");
    $::parameters .= "-f $fixed_feature ";
  }

  -l <labels:s>	              '+' enables label recognition; '-' disables it.
  {
    die "The argument to '-l' must be either '+' or '-'"
      if ($labels ne "+" && $labels ne "-");
    $::parameters .= "-l $labels ";
  }

  -m <multiple_labels:s>	    '+' enables multiple labels; '-' disables it.
  {
    die "The argument to '-m' must be either '+' or '-'"
      if ($multiple_labels ne "+" && $multiple_labels ne "-");
    $::parameters .= "-m $multiple_labels ";
  }

  -o <output_mode:s>	        Specifies a SNoW output mode.  Must be one of
                              'accuracy', 'winners', 'allpredictions',
                              'allactivations', or 'allboth'.
  {
    die qq(The argument to '-o' must be one of:
              'accuracy'
              'winners'
              'allpredictions'
              'allactivations'
              'allboth')
      if ($output_mode ne "accuracy" && $output_mode ne "winners"
          && $output_mode ne "allpredictions"
          && $output_mode ne "allactivations" && $output_mode ne "allboth");
    $::parameters .= "-o $output_mode ";
  }

  -p <prediction_threshold:n>	Specifies a floating point prediction threshold.
  { $::parameters .= "-p $prediction_threshold "; }

  -v <verbosity:s>	          Specifies the verbosity level.  Must be one of
                              'off', 'min', 'med', or 'max'.
  {
    die "The argument to '-v' must be one of 'off', 'min', 'med', or 'max'."
      if ($verbosity ne "off" && $verbosity ne "min" && $verbosity ne "med"
          && $verbosity ne "max");
    $::parameters .= "-v $verbosity ";
  }

  -w <winnow_smoothing:n>	    Specifies a smoothing parameter for Winnow or
                              Perceptron.
  { $::parameters .= "-w $winnow_smoothing "; }
);


# SNoW's server mode has its own communication protocol designed to prevent
# buffer over-runs.  When sending data to the server, the client must first
# send a 4 byte big endian integer representing the size in bytes of that
# data.  When the server sends data to the client, it follows the same
# procedure.


# First, establish a connection with the server.
$socket = Connect($port, $server_name);

# Next, send the server your parameters.
send $socket, pack("N", length $parameters), 0;
print $socket $parameters;
# You can (and should) use the statement commented below instead of the two
# statements above if you have no parameters to send:
#send $socket, pack("N", 0), 0;

# Whether you sent parameters or not, the server will then send you
# information about the algorithms used in training the network.
$message = ReceiveFrom($socket);
print $message;


# Now, we're ready to start sending examples and receiving the results.  As
# long as $testing_file has one example per line, the following loop works
# like a charm.
open IN, $testing_file or die "Can't open $testing_file for input: $!\n";
while (<IN>)
{
  # Send one example:
  send $socket, pack("N", length $_), 0;
  print $socket $_;

  # Receive the server's classification information:
  $message = ReceiveFrom($socket);
  print $message;
}
close IN;

# Last, tell the server that this client is done.
send $socket, pack("N", 0), 0;


sub Connect#($port, $server_name)
{
  my($port) = $_[0];
  my($server_name) = $_[1];
  my($socket); 
  $socket = new IO::Socket::INET(
     PeerAddr => $server_name,
     PeerPort => $port,
     Proto    => 'tcp',); 
  die "Can't connect to $port: $!\n" unless $socket;
  return $socket;
} 



sub ReceiveFrom#($socket)
{
  my($socket) = $_[0];
  my($length, $char, $msg, $message, $received);

  $received = 0;
  $message = "";
  while ($received < 4)
  {
    recv $socket, $msg, 4 - $received, 0;
    $received += length $msg;
    $message .= $msg;
  }
  $length = unpack("N", $message);

  $received = 0;
  $message = "";
  while ($received < $length)
  {
    recv $socket, $msg, $length - $received, 0;
    $received += length $msg;
    $message .= $msg;
  }

  return $message;
}