view release on metacpan or  search on metacpan

bin/linkMpca  view on Meta::CPAN

# encoding pragmas follow any includes like "use"
use encoding 'utf8';
use open ':utf8';

# build MPCA components, 1 is "no", must be the default 
my $COMPS = 1; 
#  number of entries per component per report 
my $MAXREP = 50; 

my $reporting = 0;
my $norank = 0;
my $onerank = 0;
my $stem = "";

#################################################################
#
#  Run
#
#################################################################

GetOptions(
     'man'       => sub {pod2usage(-exitstatus => 0, -verbose => 2)},
      'onerank' => \$onerank,
      'norank' => \$norank,
      'fields=i' => \$MAXREP,
      'reporting' => \$reporting,
      'h|help'       => sub {pod2usage(1)}
);

pod2usage(-message => "ERROR: need number of components and stem")
      if ( $#ARGV != 1 );

$COMPS = shift();
$stem = shift();

my $mstem = "$stem$COMPS";

if ( ! -f "$stem.srcpar" ) {
  print STDERR "Need $stem.srcpar file\n";
  exit(1);
}
if ( $onerank ) {
  if ( ! -f "$stem.docs" ) {
    print STDERR "Need $stem.docs file\n";
    exit(1);
  }
  if ( ! -f "$stem.dochash" ) {
    print STDERR "Need $stem.dochash file\n";
    exit(1);
  }
  print STDERR "\nNow building single rank\n";
  print STDERR "========================\n";
  system("mprank -u -h $stem");
  #  turn off character processing on this since am using unpack()
  open(INF,'<:bytes',"$stem.onerank");
  open(INH,"<$stem.dochash");
  my $buf = ""; 
  read(INF,$buf,4); 
  my $I = unpack("i",$buf);
  my $dhash = "";
  my $docid = 0;
  #   the binary read and unpack() combo reads
  #   entries from an MPCA Vec_t file
  my %hashrank = ();
  for (my $i=0; $i<$I; $i++) {
    read(INF,$buf,4);
    if ( eof(INH) ) {
      print STDERR "Too few entries in $stem.dochash for $stem.onerank\n";
      exit(1);
    }
    $_ = <INH>;
    /^([a-z0-9]+) /i;
    $hashrank{$1} = unpack("f",$buf)*$I;
  }
  if ( ! eof(INH) ) {
    print STDERR "Too many entries in $stem.dochash for $stem.onerank\n";
    exit(1);
  }
  close(INF);
  close(INH);
  #   merge the hashes with the numbers from .docs file
  open(OUTH,">$stem.ranks");
  open(INH,"<$stem.docs");
  while ( ($_=<INH>) ) {
    my @a = split();
    my $title = $_;
    s/^([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) //;
    if ( $a[3] =~ /^[0-9A-Fa-f]+$/ && $a[2] =~ /^[0-9A-Fa-f]+$/ ) {
      if ( ! defined($hashrank{$a[3]}) ) {
	print STDERR "No matching hash in $stem.docs: $_";
	exit(1);
      }
      print OUTH "$a[0] $hashrank{$a[3]} $title";
    } else {
      print STDERR "Bad line in $stem.docs: $_";
      exit(1);
    }
  }
  close(OUTH);
  close(INH);
} elsif ( $reporting == 0 ) {
  system("sed -e \"s/^maxcomp=.*/maxcomp=$COMPS/\" $stem.srcpar > $mstem.srcpar");
  system("mpca $mstem open=w run");
  if ( ! $norank) {
    system("mprank $mstem");
  }
} else {
  if ( ! -f "$stem.tokens" ) {
    print STDERR "Need $stem.tokens file\n";
    exit(1);
  }
  if ( ! -f "$stem.docfeats" ) {
    print STDERR "Need $stem.docfeats file\n";
    exit(1);
  }
  my %featmap = ();
  my %docfeatmap = ();
  my %docmap = ();
  open(WM,"<$stem.tokens");
  my $line = 0;
  while ( ($_=<WM>) ) {