onetipp - 04_IT - 14_Framework - Framework - ServerManager - library - cmd - SOURCE CODE

#!/usr/bin/perl -w

###################################################################
###                                                             ###
###      File: chunker-read-lemma.perl                          ###
###    Author: Dennis Spohr (spohrds@ims.uni-stuttgart.de)      ###
###   Purpose: Bypass for obtaining lemmas with french chunker  ###
###            (see also chunker-write-lemma.perl)              ###
###   Created: Tue Feb 13 2007                                  ###
###                                                             ###
###################################################################

# wait for 5 seconds to ensure that a portion of the lemmas has been 
# written to the file before attempting to read from the file
sleep(5);

open(IN,"<lemmas.txt");

while (<>) {

    # print chunker output
    chomp;
    print;

    # attach lemma
    $in = <IN>;
    if (defined $in) {
      print "\t$in" if defined $in;
    } else {
      print "\n";
    }

}

close(IN);

# remove lemma file
system("rm lemmas.txt");

#!/usr/bin/perl -w

###################################################################
###                                                             ###
###      File: chunker-write-lemma.perl                         ###
###    Author: Dennis Spohr (spohrds@ims.uni-stuttgart.de)      ###
###   Purpose: Bypass for obtaining lemmas with french chunker  ###
###            (see also chunker-read-lemma.perl)               ###
###   Created: Tue Feb 13 2007                                  ###
###                                                             ###
###################################################################

open(OUT,">lemmas.txt");

# flush filehandle for unbuffered output
my $ofh = select OUT;
$| = 1;
select $ofh;

while (<>) {

    chomp;
    (@F)=split("\t");

    # print token and tag/chunk to STDOUT
    # print lemma to lemma file
    if ($#F==0){
	print OUT "\n";
	print "$_\n";
    } else {
	print OUT "$F[2]\n";
	print "$F[0]-$F[1]\n";
    }

}

close(OUT);

#!/usr/bin/perl

###################################################################
###                                                             ###
###      File: filter-chunker-output.perl                       ###
###    Author: Michel Genereux                                  ###
###            (indicated modifications by Dennis Spohr (DS))   ###
###   Purpose: Filter chunker output and create XML-like markup ###
###   Created: Mon Feb 19 2007                                  ###
###                                                             ###
###################################################################

use Getopt::Std;
getopts('t');

$| = 1;

print doc_start();

### DS start: end-of-sentence marker
$eos = '[.?!;]';
$push = 1;
###

$n = 0;

while (<>) {
  s/.-SBAR$/O/;
  s/I-PC$/0/  if (/I-PC$/ && !$inside_pp);

  ### DS start: process lemma column
  if (($token[$n],$tag[$n],$tag,$chunk[$n],$lemma[$n]) = $_ =~ /^(.*)-(.*)\t(.*)\/(.*)\t(.*)$/) {
  ### DS end

    ### DS start: chunking error; some SENTs have e.g. I-NP although
    ###           they mark the end of a sentence; lead to omission 
    ###           of closing tags
    $push = 0;
    $chunk[$n] = 0 if ($tag eq 'SENT' && $chunk[$n] =~ /^(I|B)-/);
    ### DS end

    if ($chunk[$n] =~ /^(.*)-(.*)$/) {
      $flag[$n] = $1;
      $chunk[$n] = $2;
    } else {
      undef $flag[$n];
      undef $chunk[$n];
    }

    ### DS start: performance boost: set $n to 0 after printing

... [truncated, 180 more lines] ...

#!/usr/bin/perl

use Getopt::Std;
getopts('t');

print doc_start();

$n = 0;
while (<>) {
  s/.-SBAR$/O/;

  if (/^(.*)-(.*)\t(.*)\/(.*)$/) {
    $token[$n] = $1;
    $tag[$n] = $2;
    $chunk[$n] = $4;
    if ($chunk[$n] =~ /^(.*)-(.*)$/) {
      $flag[$n] = $1;
      $chunk[$n] = $2;
    }
    else {
      undef $flag[$n];
      undef $chunk[$n];
    }
    print_sentence()  if $token[$n] eq '.';
    $n++;
  } 

  else {
    $markup[$n] .= $_;
  }
}

print_sentence();
print doc_end();


sub print_sentence {
  my($i,$chunk);

  for( $i=0; $i<=$n; $i++ ) {

    if ($flag[$i] eq 'I' && $chunk ne $chunk[$i]) {
      $flag[$i] = 'B';
    }

    if ($flag[$i] eq 'B') {
      if (defined $chunk) {
	$cetags[$i-1] = end_tag($chunk);
      }
      $chunk = $chunk[$i];

... [truncated, 76 more lines] ...

#!/usr/bin/perl

use Getopt::Std;
getopts('t');

print doc_start();

$n = 0;
while (<>) {
  s/.-SBAR$/O/;

  if (/^(.*)-(.*)\t(.*)\/(.*)$/) {
    $token[$n] = $1;
    $tag[$n] = $2;
    $chunk[$n] = $4;
    if ($chunk[$n] =~ /^(.*)-(.*)$/) {
      $flag[$n] = $1;
      $chunk[$n] = $2;
    }
    else {
      undef $flag[$n];
      undef $chunk[$n];
    }
    print_sentence()  if $token[$n] eq '.';
    $n++;
  } 

  else {
    $markup[$n] .= $_;
  }
}

print_sentence();
print doc_end();


sub print_sentence {
  my($i,$chunk);

  for( $i=0; $i<=$n; $i++ ) {

    if ($flag[$i] eq 'I' && $chunk ne $chunk[$i]) {
      $flag[$i] = 'B';
    }

    if ($flag[$i] ne '' && $token[$i] eq '.') {
      delete $flag[$i];
      $chunk[$i] = '0';
    }


... [truncated, 74 more lines] ...

#!/usr/bin/perl

###################################################################
###                                                             ###
###      File: filter-coordinate-output.perl                    ###
###    Author: Dennis Spohr (spohrds@ims.uni-stuttgart.de)      ###
###   Purpose: Combine coordinated NPs into larger NP (also if  ###
###            embedded in PP(s))                               ###
###   Created: Tue Feb 13 2007                                  ###
###                                                             ###
###################################################################

use strict;

# queue for storing the content of the NPs
my @queue = ();

# current line
my $line = "";

# (possible) closing PP tags
my $pps = "";

# flush STDOUT for unbuffered output
$| = 1;

while($line = <>) {

    # first NP is encountered
    np:if ($line =~ /^<NP>/) {

       push(@queue,$line);

       # read until closing NP tag
       until ($line =~ /^<\/NP>/) {
          $line = <> or last;
          push(@queue,$line);
       }
       unless (defined $line) {
	   print @queue;
	   last;
       }

       $line = <>;
       $pps = "";

       # read possible closing PP tags
       while ($line =~ /^<\/PP>/) {
          $pps .= $line;
          $line = <>;

... [truncated, 125 more lines] ...

#!/usr/bin/perl

# Usage: lookup.perl <file>*
# Perl script to be used prior to tagging

# It assigns sets of possible tags to selected word forms.
# The tag information is read from the first argument file.
# The format of this file is:
# <word form><tab>[<tag><whitespace>{<tag prob.><whitespace>}]*
# The word form which may contain blanks is followed by a tab character
# and a sequence of tags separated by whitespace. The tags are optionally
# followed by tag probability values in the range from 0.0 to 1.0.

$LEXICON = shift;
open(LEXICON);
while (<LEXICON>) {
  if (s/^(.*?)\t//) {
    $word = $1;
    s/\s*\t\s*/\t/g;
    s/ +/ /g;
    $tag{$word} = $_;
  }
}
close(LEXICON);

while (<>) { 
  chop();
  s/[ \t\n][ \t\n]*/ /go;
  s/^[ \t\n]*(.*[^ \t\n])[ \t\n]*$/$1/go;
  if (defined($tag{$_})) {
    print $_,"\t",$tag{$_};
  }
  else {
    print "$_\n";
  }
}

#!/usr/bin/perl

$Threshold = 10;

while (<>) {
  chomp;
  @F = split("\t");
  $count{$F[0]}++;
  $count2{"$F[0]\t$F[1]"}++;
  if ($F[0] =~ s/.*-//) {
    $count{$F[0]}++;
    $count2{"$F[0]\t$F[1]"}++;
  }
}

foreach $p (keys %count2) {
  my ($w,$t) = split("\t", $p);
  if ($count{$w} > $Threshold || $w !~ /-/) {
    $tags{$w} .= "\t$t #";
  }
}

foreach $w (sort keys %tags) {
  print $w,$tags{$w},"\n";
}

#!/usr/bin/perl

# use Getopt::Std;
# getopts('h');

while (<>) {
    next if $_ eq "\n";
    chomp;
    die "Error in line: $_" unless /^(.+?)\s*\t\s*(\S+)(\s+(.+?))?\s*$/;
    $w = $1;
    $t = $2;
    $l = (defined $4) ? $4 : "-";
    $lemma{"$w\t$t"} = $l;
}

foreach $p (sort keys %lemma) {
    my($w,$t) = split(/\t/,$p);
    $tags{$w} .= "\t$t $lemma{$p}";
}

foreach $w (sort keys %tags) {
    print $w,$tags{$w},"\n" unless $w =~ /^[0-9][0-9,.:;\/]+$/;
}

#!/usr/bin/perl

use Getopt::Std;
getopt('dhf:');

# This perl script recognizes multi word units in the input stream
# and puts them on one line. Input must have one-word-per-line format.
# The multi word units are listed in the parameter file with POS tags.
# Each line contains one multi word unit where the individual words
# are separated by blanks followed by a tab character and the blank-
# separated list of POS tags.
# Author: Helmut Schmid, IMS, Uni Stuttgart

if (!defined($opt_f) || defined($opt_h)) {
  $0 =~ s/.*\///;
  printf "\nUsage: $0 [-d del] -f mwl-file ...files...\n";
  print "\nOptions:\n";
  print "-d del : Use del as delimiter rather than a blank\n\n";
  die
}

if (!open(FILE, $opt_f)) {
  die "\nCan't open mwl file: ",$opt_f,"\n";
}
if (defined($opt_d)) {
  $del = $opt_d;
} else {
  $del = " ";
}

$N=1;
while (<FILE>) {
  chomp();
  @G = split("\t");
  @F = split(/\s+/,$G[0]);
  $state = 0;
  for($i=0; $i<=$#F; $i++) {
    if (!exists($arc{$state,$F[$i]})) {
      $arc{$state,$F[$i]} = $N++;
    }
    $state = $arc{$state,$F[$i]};
   }
  $final{$state} = $G[1];
}
close(FILE);


$last = $match = $last_match = 0;
$state = 0;


... [truncated, 47 more lines] ...

#!/usr/bin/perl -w

binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
use utf8;

$par = shift(@ARGV);

if ($par eq "-yes") {
    $NP_default_tag = "NP00000"
}
if ($par eq "-no") {
    $NP_default_tag = "NP0"
}

while (<>) {
    chop($_);

    if ($_ eq "" || $_ =~ /^<[\w\W]*>$/ || $_ !~ /\t/ )  {
	next
    }
    else {

	($token, $tag, $lemma) = split("\t", $_);

	# identificar um possível nome próprio (desconhecido ou composto) 
	# e passar lemma a minúscula:
	if ($lemma =~ /<unknown>/ && $token =~ /^[A-ZÁÉÍÓÚÂÊÎÔÛÀÈÌÒÙÑÇ]/) {
	    $tag = $NP_default_tag;
	    $lemma =  lc($token);       
	}
	
	print "$token\t$tag\t$lemma\n";
    }
}

#!/usr/bin/perl -w

#Splitter de procliticos e contraçoes para o Portugues

#author: Pablo Gamallo
#date: 18/11/2011
use utf8;
use Encode;

use locale;
use POSIX;
setlocale(LC_CTYPE,"pt_PT");

my $pron = "(me|te|mos|mas|mo|ma|tos|tas|to|ta|o|os|a|as|se|lhe|lhes|lho|lha|lhos|lhas|nos|vos|no-lo|no-los|no-la|no-las|vo-lo|vo-los|vo-la|vo-las|se-nos|se-vos|se-lhe|se-lhes|se-lho|se-lhos|se-lha|se-lhas)";


while ($line = <>) {
    $line = decode('UTF8', $line);
    chomp $line;

############separar ,...############
    $line =~ s/\,\.\.\./\, \.\.\./g;

###############Verbos + procliticos######################
    ##caso m-no -> m-o
    $line =~ s/m\-n([oa])\b/m\-$1/g;
    $line =~ s/m\-n([oa]s)\b/m\-$1/g; 

    ##separar cliticos compostos no-lo, vo-lo, se-nos...
    $line =~ s/([\-\W\s])(no|vo)-(l[oa]|l[oa]s)([\W\s])/$1$2s $3$4/g;
    $line =~ s/([\-\W\s])(no|vo)-(l[oa]|l[oa]s)$/$1$2s $3/g;
    $line =~ s/([\-\W\s])(se)-(n[oa]s|lh[eoa]s)([\W\s])/$1$2 $3$4/g;
    $line =~ s/([\-\W\s])(se)-(n[oa]s|lh[eoa]s)$/$1$2 $3/g;

  ##separar procliticos de verbos
  $line =~ s/([^\-\s]+)\-$pron([\W\s])/$1 $2$3/g;
    $line =~ s/([^\-\s]+)\-$pron$/$1 $2/g;

    ##separar cliticos compostos: mo, mos, to, tos, lho, lhos..
    $line =~ s/\bmo\b/me o/g;
    $line =~ s/\bmos\b/me os/g;
    $line =~ s/\bma\b/me a/g;
    # $line =~ s/\bmas\b/me as/g; AMBIGUO
    $line =~ s/\bto\b/te o/g;
    $line =~ s/\btos\b/te os/g;
    $line =~ s/\bta\b/te a/g;
    $line =~ s/\btas\b/te as/g;
    $line =~ s/\blhoo\b/lhe o/g;
    $line =~ s/\blhos\b/lhe os/g;
    $line =~ s/\blha\b/lhe a/g;

... [truncated, 145 more lines] ...

#!/usr/bin/perl

use warnings;
use strict;
use utf8::all;

my $filename = shift or die "Error: missing argument file!\n";
open(FILE,$filename) or die "Error: unable to open file \"$filename\"!\n";
my %exception;
while(<FILE>) {
    chomp;
    $exception{$_} = 1;
}

while (<>) {
    chomp;

    my $initial = '';
    my $final = '';

    if (s/^(şi)(-n)$/$1/i || s/^(mi)(-i)$/$1/i) {
	$final = "$2\n$final";
    }

    while (!exists $exception{lc $_} && 
	   s/^(.+)(-(n[ţtcvfgdşs]\p{L}*|m[bp]\p{L}*))$/$1/) {
	$final = "$2\n$final";
    }

    if (!exists $exception{lc $_} && 
	   s/^((\p{L}*ntr|şi|s|n|de|i|ţi|pe|te|mi|l|m|c|le|v|dac|ne|ş|parc|d|fii|dă)-)(.+)$/$3/i) {
	$initial = "$1\n";
    }

    while (!exists $exception{lc $_} && 
	   s/^(.+)(-(i|l|t|m|şi|ţi|o|se|mi|n|ului|te|un|ul|ai|mă|am|le|s|a|sa|urilor|ilor|astea|vă|aşa|ăla|al|ar|aici|eşte|au|t\'|m\'|mea|ăştia|napoi|ţ\'|aş|alea|aţi|ăsta))$/$1/) {
	$final = "$2\n$final";
    }

    while (!exists $exception{lc $_} && 
	   s/^(.+)(-(n[ţtcvfgdş]\p{L}*|m[bp]\p{L}*))$/$1/) {
	$final = "$2\n$final";
    }

    print "$initial$_\n$final";
}

#!/usr/bin/perl

########################################################################
#                                                                      #
#  tokenization script for tagger preprocessing                        #
#  Author: Helmut Schmid, IMS, University of Stuttgart                 #
#                                                                      #
#  Description:                                                        #
#  - splits input text into tokens (one token per line)                #
#  - cuts off punctuation, parentheses etc.                            #
#  - cuts of clitics like n't in English                               #
#  - disambiguates periods                                             #
#  - preserves SGML markup                                             #
#  - reads the whole file at once and should therefore not be called   #
#    with very large files                                             #
#                                                                      #
########################################################################

use Getopt::Std;
getopts('hfeiza:w');

# Modify the following lines in order to adapt the tokenizer to other
# types of text and/or languages

# characters which have to be cut off at the beginning of a word
my $PChar='[{¿¡\'\`\´"»«\202\204\206\207\213\221\222\223\224\225\226\227\233';

# characters which have to be cut off at the end of a word
my $FChar=']}\'\`\´\",;:\!\?\%»«\202\204\205\206\207\211\213\221\222\223\224\225\226\227\233';

# character sequences which have to be cut off at the beginning of a word
my $PClitic;

# character sequences which have to be cut off at the end of a word
my $FClitic;

if (defined($opt_e)) {
    # English
    $FClitic = "['´](s|re|ve|d|m|em|ll)|n['´]t";
}
if (defined($opt_i)) {
    # Italian
    $PClitic = "(?:[dD][ae]ll|[nN]ell|[Aa]ll|[lLDd]|[Ss]ull|[Qq]uest|[Uu]n|[Ss]enz|[Tt]utt|[Cc]|[Ss])['´]";
}
if (defined($opt_f)) {
    # French
    $PClitic = "(?:[dcjlmnstDCJLNMST]|[Qq]u|[Jj]usqu|[Ll]orsqu)['´]";
    $FClitic = "-t-elles?|-t-ils?|-t-on|-ce|-elles?|-ils?|-je|-la|-les?|-leur|-lui|-mmes?|-m['´]|-moi|-nous|-on|-toi|-tu|-t['´]|-vous|-en|-y|-ci|-là";
}
if (defined($opt_z)) {

... [truncated, 176 more lines] ...

#!/usr/bin/perl

########################################################################
#                                                                      #
#  tokenization script for tagger preprocessing                        #
#  Author: Helmut Schmid, IMS, University of Stuttgart                 #
#          Serge Sharoff, University of Leeds                          #
#  Description:                                                        #
#  - splits input text into tokens (one token per line)                #
#  - cuts off punctuation, parentheses etc.                            #
#  - disambiguates periods                                             #
#  - preserves SGML markup                                             #
#                                                                      #
########################################################################

use Getopt::Std;
use utf8;
use Encode;

getopts('hgfeiza:r');

# Modify the following lines in order to adapt the tokenizer to other
# types of text and/or languages

# characters which have to be cut off at the beginning of a word
my $PChar='[¿¡{\'\\`"‚„†‡‹‘’“”•–—›';

# characters which have to be cut off at the end of a word
my $FChar=']}\'\`\",;:\!\?\%‚„…†‡‰‹‘’“”•–—›';

# character sequences which have to be cut off at the beginning of a word
my $PClitic='';

# character sequences which have to be cut off at the end of a word
my $FClitic='';

if (defined($opt_r)) {
    # Romanian
    $PChar='[¿¡{\\`"‚„†‡‹‘’“”•–—›';
    $FChar=']}\`\",;:\!\?\%‚„…†‡‰‹‘’“”•–—›';
}
if (defined($opt_e)) {
    # English
    $FClitic = "['’´](s|re|ve|d|m|em|ll)|n['’´]t";
}
if (defined($opt_i)) {
    # Italian
    $PClitic = "(?:[dD][ae]ll|[nN]ell|[Aa]ll|[lLDd]|[Ss]ull|[Qq]uest|[Uu]n|[Ss]enz|[Tt]utt|[Cc]|[Ss])['´’]";
}
if (defined($opt_f)) {

... [truncated, 181 more lines] ...