#!/usr/bin/env perl

use utf8;
use 5.008;
use strict;
use warnings;
use autodie;
use List::MoreUtils qw( any all );
#use Readonly;

# Pracuje se vstupem T: FORMA_LEMMA_TAG_AFUN_ORD_HEAD (pro trénink)
# NEBO
# se vstupem N: FORMA_LEMMA_TAG (pro anotaci nového textu)

# Výstup: CoNLL formát:
# ord	form	lemma	POS	POS	features	head	afun	head	afun
# a v případě _nových dat_ vytváří také BACKUP:
# newform	newlemma	form	lemma	tag
#
#
# FEATURES:
# Synt: Synt.noun (N), synt.pronoun (P), synt.adj.(A), synt.pron/synt.adj. (p), synt.adj./synt.pron (a),
# num.5+(n), num.synt.subst.(C), num.synt.adj.(c), num.1234 (l), num.graf. (=), num.part.(y)
# synt.adv.(D), prep.(R), conj.para.(^), conj.hypo(,)
# VForm (kombinuje druhou,devátou a dvanáctou pozici u sloves)
# NSynt (některé syntakticky relevantní rysy substantiv)
# PSynt (jen syntakticky relevantní rysy u zájmen: vztažné, refl. aj.)
# NumGen (kombinuje třetí a čtvrtou pozici)
# Case (1-7 a X)
# Pers (1-3)
# Grade (jen 2 a 3)
# Abbr (=1)
# CPrep (=1: part of)


# LEMMAS and FORMS:
# Zjednodušuje některé kategorie
# - vždy ruší "ocásek" lemmat
# - některé kategorie (vlastní jména) sjednocuje na jeden společný tvar (anonymizace)
# - některá přídavná jména (přivlastňovací) sjednocuje na jeden společný tvar
# - některé číslovky sjednocuje na společné tvary: číslicí psané, pět+, deset+, pátý+ , pětkrát atd.
# - u předložek eliminuje vokalizaci
# -

#
# ./SimplifyInputForParsers.pl -Trck ./directory_to_simplify
# ./SimplifyInputForParsers.pl -TrckC3L ./directory_to_simplify

# ------------------------------------------------------------------------------

binmode(STDOUT, ":utf8");
my $in_format = 'T';
my $simplify_forms = 1;
my $out_format = 'M';
my $mcd_lemmas = 0;
my $single_output = '';
my $lc_first_form = 1;
my $zeman_like_conll_features = 0;
my $remove_combined_afs = 0;
my $modify_subord_verb_afs = 0;
my $unify_coap_sfx = 0;
my $allow_chunking = 0;
my $additional_in_vert = 0;

if ($ARGV[0] =~ /^-([TN]?[Aa]?[Ffl]?[rvck]{0,4}((Mz?)|(C[2345]?L?))?)|([Hh](elp)?)$/) {
    my $format_options = shift @ARGV;
    if ($format_options =~ /N/) { $in_format = 'N'; }
    if ($format_options =~ /[Aa]/) { $additional_in_vert = 1;}
    if ($format_options =~ /M/) { $out_format = 'M'; }
    if ($format_options =~ /Mz/) { $zeman_like_conll_features = 1; }
    if ($format_options =~ /C[2345]?L?/) {
	$out_format = $format_options; $out_format =~ s/.*(C[2345]?)[^2345]*$/$1/; 
	if ($format_options =~ /C[2345]?L/) { $mcd_lemmas = 1; }
    }
    if (($in_format eq 'T')&&(($format_options =~ /[TN][Fflvck]*r/)||($format_options =~ /^-[Fflvck]*r/))) {
	$remove_combined_afs = 1; }
    if (($in_format eq 'T')&&(($format_options =~ /[TN][Fflrck]*v/)||($format_options =~ /^-[Fflrck]*v/))) {
	$modify_subord_verb_afs = 1; }
    if (($in_format eq 'T')&&(($format_options =~ /[TN][Fflrvk]*c/)||($format_options =~ /^-[Fflrvk]*c/))) {
	$unify_coap_sfx = 1; }
    if ($format_options =~ /k/) { $allow_chunking = 1; }
    if ($format_options =~ /F/) { $simplify_forms = 0; $lc_first_form = 0; }
    if ($format_options =~ /f/) { $simplify_forms = 2; $lc_first_form = 0; }
    if (($format_options =~ /l/)&&($format_options !~ /[Hh]elp/)) { $lc_first_form = 0; }
    if ($format_options =~ /[Hh]/) {
	print "SimplifyInputForParsers\nZjednodušuje vstup, nastavuje features pro MALT a MST parsery.\nSpouštění:\n";
	print "SimplifyInputForParsers.pl -[NTFMC[2345]] (-o single_output_file) /directory/ \n";
	print "-N (nový text, ne train) -F (nezjednodušovat formy a lemmata) -M (MALT parser - default), -C[2345] (MST parser, délka tagů)\n";
	exit;
    }
}
else { die "Wrong options, see -help!\n"; }

if (($ARGV[0] eq '-o')&&(defined $ARGV[1])&&(defined $ARGV[2])) {
    shift @ARGV;
    $single_output = shift @ARGV;
    $single_output =~ s/(.+)(\.(vert)|(mcd)|(conll))$/$1/;
}

my $INPUT_DIR = $ARGV[0];
chomp $INPUT_DIR;
$INPUT_DIR =~ s|(.+)\/$|$1|;

binmode STDOUT, ":utf8";
#print "Pracuji ve složce $INPUT_DIR\n";

# ------------------------------------------------ - --- ---- --- -----
# --- -- Deklarace obecně používaných polí pro zpracování textu. --- --
# ------------------------------------------------ - --- ---- --- -----
my (@z_forms, @z_lemmas, @z_tags, @z_afuns, @z_heads, @z_features, @new_forms, @new_lemmas, @new_tags, @new_afuns, @new_heads, @synt_features);
my $tokens_processed = 0;
my (@ch_forms, @ch_lemmas, @ch_ords);
my @recover_chunking;
my @additional;

# ------------------------------------------------ - --- ---- --- -----
# --------------- Seznamy slov a jejich vlastností - --- ---- --- -----
# ------------------------------------------------ - --- ---- --- -----
my $IN;
my $LINGDATA_FILE = './SimplifyInput_LingData.tsv';

# ------------------------------------------------ -- -- -- -- -- -- --
# -------------   Načítání seznamů   ------------- -- -- -- -- -- -- --
# ------------------------------------------------ -- -- -- -- -- -- --

my %NOUNS_PERS; # Všechna vlastní jména označující osoby (P), křestní jména (G), apelativa typu "pan", "soudruh", "doktor" aj (A).
my %NOUNS_TOWNS; $NOUNS_TOWNS{'Praha'}{'FS'} = 'C';
my %NOUNS_TOWNS_ON_R;
my %NOUNS_MONTHS;
my %NOUNS_REG;
my %NOUNS_STATES;
my %NOUNS_CARS;
my %ADJ_TYPE;
my %ADV_TYPE;
my %ADJ_REFL;
my %ADJ_VRB_REPL;
my %VERBS_simp;
my %CONVERT_FORMS; $CONVERT_FORMS{'Jan'}{'S1'} = 'Jan';
my %UTKL_2_PDT_FILTER_forms;
my %UTKL_2_PDT_FILTER_lemmas;
my %CHUNKING_first;
my %CHUNKING;
my %CHUNKING_recover;
my $INPUT_FILE; # přemístěno sem kvůli chybovým hlášením

open $IN, '<:utf8', $LINGDATA_FILE;
while (<$IN>) {
    chomp;
    my (@ling_data) = split /\t/, $_;
    my $data_type = shift (@ling_data);
    if ($data_type eq 'noun') {
	my $noun_type = shift(@ling_data);
	if ($noun_type eq 'pers') {
	    my ($n_lemma,$n_value) = (@ling_data);
	    if ($n_value =~ /^[AGP]$/) {
		$NOUNS_PERS{$n_lemma}=$n_value;
	    }
	}
	elsif ($noun_type eq 'towns') {
	    my ($t_lemma, $t_ng, $t_type) = (@ling_data);
	    $t_ng =~ s/XP/P/;
	    if (not defined $t_type) { $t_type = '1'; }
	    elsif ($t_type eq 'cap') { $t_type = 'C'; }
	    else { $t_type = '1'; }
	    $NOUNS_TOWNS{$t_lemma}{$t_ng} = $t_type;
	}
	elsif ($noun_type eq 'towns_on_rivers') {
	    my ($t_lemma, $t_prep, $t_river) = (@ling_data);
	    if ((defined $t_river)&&($t_river =~ /^[A-ZŠČŘŽĎŤŇÚ].+/)) {
		$NOUNS_TOWNS_ON_R{$t_lemma}{$t_prep}{$t_river} = 1; }
	}
	elsif ($noun_type eq 'reg_sko') {
	my ($n_lemma) = (@ling_data);
	    $NOUNS_REG{$n_lemma} = 1;
	}
	elsif ($noun_type eq 'states') {
	    my ($n_lemma, $n_type) = (@ling_data);
		$NOUNS_STATES{$n_lemma} = $n_type;
	}
	elsif ($noun_type eq 'cont') {
	    my ($n_lemma, $n_type) = (@ling_data);
		$NOUNS_STATES{$n_lemma} = $n_type . '.C';
	}
	elsif ($noun_type eq 'cars') {
	    my ($n_lemma, $n_type) = (@ling_data);
		$NOUNS_CARS{$n_lemma} = $n_type;
	}
    }
    elsif ($data_type eq 'convert') {
	my ($f_lemma, $f_tag, $f_form) = (@ling_data);
	if ((defined $f_form) && ($f_form ne "")) {
	    $CONVERT_FORMS{$f_lemma}{$f_tag}=$f_form;
	}
    }
    elsif ($data_type eq 'adj') {
	my ($a_lemma, $a_type, $a_replace) = (@ling_data);
	if (($a_type =~ /^[tnrm]$/)||($a_type =~ /^ADJ_NT/)) {
	    $ADJ_TYPE{$a_lemma} = $a_type; }
	elsif ($a_type eq 'colours') {
	    $ADJ_TYPE{$a_lemma} = 'clr'; }
	elsif ($a_type =~ /^adj_((ici)|(ny))$/) {
	    my $adjverbtype = $a_type; $adjverbtype =~ s/^adj_((ici)|(ny))$/$1/;
	    $ADJ_TYPE{$a_lemma} = $adjverbtype;
	    $ADJ_VRB_REPL{$a_lemma} = $a_replace;
	}
    }
    elsif ($data_type eq 'adv') {
	my ($a_lemma, $a_type) = (@ling_data);
	if ($a_type =~ /^[tnrm]$/) {
	    $ADV_TYPE{$a_lemma} = $a_type; }
	elsif ($a_type eq 'colours') {
	    $ADV_TYPE{$a_lemma} = 'clr'; }
    }
    elsif ($data_type eq 'UTKL_2_PDT') {
	my ($ff,$l1,$t1,$l9,$t9) = (@ling_data);
	$UTKL_2_PDT_FILTER_forms{$ff} = $l9 . "\t" . $t9;
	my $t2 = substr($t1,0,2);
	if ($t2 eq 'TT') {
	    $UTKL_2_PDT_FILTER_lemmas{$l1}{'TT'} = $l9 . "\t" . $t9; }
    }
    elsif ($data_type eq 'ADJ_REFL') {
	my ($a_lemma,$new_lemma) = (@ling_data);
	$ADJ_TYPE{$a_lemma} = $data_type;
	$ADJ_REFL{$a_lemma} = $new_lemma;
    }
    elsif ($data_type eq 'vrb_simp') {
	my ($v_lemma,$simp_tag,$v_replace) = (@ling_data);
	if (defined $v_replace) {
	    $VERBS_simp{$v_lemma}=$v_replace; }
    }
    elsif (($data_type eq 'chunking')&&($allow_chunking==1)) {
	my (@chunks) = (@ling_data);
	my $chunks_c = $#chunks+1;
	my @chunks_fl;
	my @chunks_re;
	my $first_chunk;
	my $reg_chunk;
	foreach my $chunk (@chunks) {
	    my ($chnum,@chs) = split /:/, $chunk;
	    if ($chnum == 0) {
		if ($chs[0] ne 'R') {
		    my $chf = $chs[0];
		    if (not defined $CHUNKING_first{$chf}{$chunks_c}) {
			$CHUNKING_first{$chf}{$chunks_c} = 1; }
		    push (@chunks_fl, "F:$chf"); $first_chunk=$chf;
		    push (@chunks_re, "$chs[1]:$chs[2]"); }
		elsif ($chs[1] eq 'F') {
		    my $chf = $chs[2];
		    if (not defined $CHUNKING_first{$chf}{$chunks_c}) {
			$CHUNKING_first{$chf}{$chunks_c} = 1; }
		    push (@chunks_fl, "F:$chf"); $first_chunk=$chf;
		    push (@chunks_re, "R");
		    $reg_chunk=0; }
		elsif ($chs[1] eq 'L') {
		    my $chl = $chs[2];
		    if (not defined $CHUNKING_first{$chl}{$chunks_c}) {
			$CHUNKING_first{$chl}{$chunks_c} = 1; }
		    push (@chunks_fl, "L:$chl"); $first_chunk=$chl;
		    push (@chunks_re, "R");
		    $reg_chunk=0; }
	    }
	    else {
		if ($chs[0] ne 'R') {
		    my $chf = $chs[0];
		    push (@chunks_fl, "F:$chf"); 
		    push (@chunks_re, "$chs[1]:$chs[2]"); }
		elsif ($chs[1] eq 'F') {
		    my $chf = $chs[2];
		    push (@chunks_fl, "F:$chf");
		    push (@chunks_re, "R");
		    $reg_chunk=$chnum; }
		elsif ($chs[1] eq 'L') {
		    my $chf = $chs[2];
		    push (@chunks_fl, "L:$chf");
		    push (@chunks_re, "R");
		    $reg_chunk=$chnum; }
	    }
	}
	my $chunk_key = '';
	foreach my $chfl (@chunks_fl) { $chunk_key .= '|' . $chfl; }
	if ($chunk_key ne '') {
	    $chunk_key=substr($chunk_key,1); 
	    $CHUNKING{$chunk_key}=$reg_chunk;
	}
	$CHUNKING{$chunk_key}=$reg_chunk;

	my $recover_ch_values = '';
	foreach my $rchv (@chunks_re) { $recover_ch_values .= '|' . $rchv; }
	if ($recover_ch_values ne '') {
	    $recover_ch_values = substr($recover_ch_values,1);
	    $CHUNKING_recover{$chunk_key}=$recover_ch_values;
	}
    }
}
close $IN;

{
foreach my $month (qw(leden únor březen duben květen červen červenec srpen říjen listopad prosinec)) {
    $NOUNS_MONTHS{$month} = 'I'; }
foreach my $alemc (qw(bílý černý rudý červený oranžový zelený žlutý)) {
    $ADJ_TYPE{$alemc} = 'clr0'; }
foreach my $obrat (qw(okrást oloupit ošidit)) {
    $VERBS_simp{$obrat}='obrat'; }
$VERBS_simp{'záviset'}='záležet';
}
# Output (využívaný v podprogramech): file-handles.
my ($OU_CONLL, $OU_MCD, $OU_BACK);
if ($single_output ne '') {
    open_output_files($single_output);
}
my $FILE_err;

# ------------------------------------------------ -- -- -- -- -- -- --
# --------   Vlastní zpracování textu   ---------- -- -- -- -- -- -- --
# ------------------------------------------------ -- -- -- -- -- -- --

my $dirDH;
#print "Opening directory:\n$INPUT_DIR\n.";
opendir($dirDH, $INPUT_DIR) or die "Error opening directory $INPUT_DIR !\n";

foreach $INPUT_FILE (sort readdir($dirDH)) {
    next if ($INPUT_FILE =~ /^\.{1,2}$/);
    next if ($INPUT_FILE !~ /.+\.vert$/);
    $INPUT_FILE = $INPUT_DIR . '/' . $INPUT_FILE;
#    print "$INPUT_FILE\n";
    $FILE_err = $INPUT_FILE;
    open my $INFILE, '<:utf8', $INPUT_FILE or die;
    if ($single_output eq '') {
	open_output_files($INPUT_FILE); }

# ============================================================
# NAČÍTÁNÍ TEXTU (CELÝ TEXT)
# Vycházíme z formátu 
# (-T = default) WORD\tLEMMA\tTAG\tAFUN\tORD\tHEAD\n, přičemž u AFUN předpokládáme i možnost koncovky _Co ap.
# (-N = prostá vertikála před synt. anotací) WORD\tLEMMA\tTAG\n.


    # Celá věta je načtena do polí a zpracovává se vcelku (zatím to není nutné, ale některé další zásahy to budou vyžadovat).
    my $z_ord = 0;
    my ($in_word,$in_lemma,$in_tag,$in_ord,$in_afun,$in_head);
    my ($in_a);
    while (<$INFILE>) {
	chomp;
	my $process_line = $_;
	if ($process_line eq '') {
	    if ($z_ord > 0) {
		process_sentence();
		print_sentence();
		$z_ord = 0;
		empty_sentence_arrays();
	    }
	    next;
	}
	elsif (($in_format eq 'T' )&& # forma, lemma, tag, afun, ord, head.
	($process_line =~ /^[^\t\ \n]+\t[^\t\ \n]+\t[NAPCVDRJTIXZYE][^\t\n\ ]{3}[\-1234567X][^\t\n\ ]{10,11}\t[^\t\ \n]+\t[0-9]+\t[0-9]+$/)) {
	    ($in_word,$in_lemma,$in_tag,$in_afun,$in_ord,$in_head) = split /\t/, $process_line;
	    $tokens_processed++;
#	    print "INPUT: $in_word\t$in_lemma\t$in_tag\t$in_afun\t$in_head\n";
	}
	elsif (($in_format eq 'T' )&& # forma, lemma, tag, head, afun. (Spousta)
	($process_line =~ /^[^\t\ \n]+\t[^\t\ \n]+\t[NAPCVDRJTIXZYE][^\t\n\ ]{3}[\-1234567X][^\t\n\ ]{10,11}\t[0-9]+\t[^\t\ \n]+$/)) {
	    ($in_word,$in_lemma,$in_tag,$in_head,$in_afun) = split /\t/, $process_line;
	    $tokens_processed++;
	}
	elsif (($in_format eq 'N' )&& # forma, lemma, tag(15-16 pozic).
	($process_line =~ /^[^\t\ \n]+\t[^\t\ \n]+\t[NAPCVDRJTIXZYE][^\t\n\ ]{3}[\-1234567X][^\t\n\ ]{10,11}$/)) {
	    ($in_word,$in_lemma,$in_tag) = split /\t/, $process_line;
	    $tokens_processed++;
	}
	elsif (($in_format eq 'N' )&&($additional_in_vert)&& # forma, lemma, tag(15-16 pozic).
	($process_line =~ /^[^\t\n]+\t[^\t\ \n]+\t[NAPCVDRJTIXZYE][^\t\n\ ]{3}[\-1234567X][^\t\n\ ]{10,11}\t[A-Za-z0-9][A-Za-z0-9]?$/)) {
	    ($in_word,$in_lemma,$in_tag,$in_a) = split /\t/, $process_line;
	    $tokens_processed++;
	}
	elsif (($in_format eq 'N' )&& # forma, lemma, tag(15-16 pozic).
	($process_line =~ /^[^\t\ \n]+\t[^\t\ \n]+\ [NAPCVDRJTIXZYE][^\t\n\ ]{3}[\-1234567X][^\t\n\ ]{10,11}$/)) {
	    my $in_lemtag;
	    ($in_word,$in_lemtag) = split /\t/, $process_line;
	    ($in_lemma,$in_tag) = split /\ /, $in_lemtag;
	    $tokens_processed++;
	}
	elsif (($in_format eq 'N' )&& # forma, lemma, tag (zbytek nás zde nezajímá)
	($process_line =~ /^[^\t\ \n]+\t[^\t\ \n]+\t[NAPCVDRJTIXZYE][^\t\n\ ]{3}[\-1234567X][^\t\n\ ]{10,11}\t[^\t\ \n]+\t[0-9]+\t[0-9]+$/)) {
	    my @junk;
	    ($in_word,$in_lemma,$in_tag,@junk) = split /\t/, $process_line;
	    $tokens_processed++;
	}
	elsif (($in_format eq 'N' )&& # forma, lemma, tag (zbytek nás zde nezajímá)
	($process_line =~ /^[^\t\ \n]+\t[^\t\ \n]+\t[NAPCVDRJTIXZYE][^\t\n\ ]{3}[\-1234567X][^\t\n\ ]{10,11}\t[0-9]+\t[^\t\ \n]+$/)) {
	    my @junk;
	    ($in_word,$in_lemma,$in_tag,@junk) = split /\t/, $process_line;
	    $tokens_processed++;
	}

	else { die "WRONG vertical input, line $. :\n$process_line\nfile: $INPUT_FILE\n"; }

	$z_ord++;
	$z_forms[$z_ord]=$in_word;
	$z_lemmas[$z_ord]=$in_lemma;
	$z_tags[$z_ord]=$in_tag;
	if ($in_format eq 'T') {
	    $z_afuns[$z_ord]=$in_afun;
	    $z_heads[$z_ord]=$in_head;
	}
	if ($additional_in_vert) {
	    $additional[$z_ord]=$in_a; }
    }
    if ($z_ord > 0) { # Zapomenutá větička z dokončeného souboru (chyběl prázdný řádek na konci).
	process_sentence();
	print_sentence();
	$z_ord = 0;
	empty_sentence_arrays();
    }
    close $INFILE;
    if ($single_output eq '') {
	close_output_files(); }
    print "*";
}
print "\n";
if ($single_output ne '') {
    close_output_files(); 
}
print "Tokens processed: $tokens_processed\n";

# ============================================================
# VLASTNÍ ZPRACOVÁNÍ VĚTY
sub process_sentence {

    if ($allow_chunking) {
	foreach my $yy (1 .. $#z_forms) { $ch_ords[$yy]=$yy; } }

    foreach my $x (1..$#z_forms) {
	my ($form, $lem, $tag, $pos) = ($z_forms[$x], $z_lemmas[$x], $z_tags[$x], substr($z_tags[$x],0,1));

	next if (($allow_chunking == 1)&&(defined $new_forms[$x])&&($new_forms[$x] eq ""));
	next if (($allow_chunking == 1)&&($in_format eq 'T')&&(not defined $z_afuns[$x]));
	next if (($allow_chunking == 1)&&(not defined $z_forms[$x]));

	if ((defined $ch_forms[$x])&&($ch_forms[$x] ne "")) { $form = $ch_forms[$x]; }
	if ((defined $ch_lemmas[$x])&&($ch_lemmas[$x] ne "")) { $lem = $ch_lemmas[$x]; }

	if (($allow_chunking == 1)&&($x<$#z_forms)&& # spouští chunkovací podprogram, pokud forma či lemma patří mezi vhodné kandidáty a chunking je povolen
	(defined $CHUNKING_first{$form})||(defined $CHUNKING_first{$lem})||(($x==1)&&(defined $CHUNKING_first{lc($form)}))) {
	    my $chunking_done;
	    $chunking_done = check_chunking($x);
	    if ($chunking_done) {
		$form = $new_forms[$x]; $lem = $new_lemmas[$x]; $tag = $new_tags[$x]; $pos = substr($tag,0,1);
	    }
	}

	if (($remove_combined_afs == 1)&&(defined $z_afuns[$x])&&($z_afuns[$x] =~ /^((Adv)|(Atr)|(Obj))((Adv)|(Atr)|(Obj))(_(Co)|(Ap))?$/)) {
	    $new_afuns[$x] = remove_combined_afuns($x);
	}
	if (($modify_subord_verb_afs == 1)&&
	($z_tags[$x] =~ /^V[Bpifs]/)&&($z_afuns[$x] =~ /^((Adv)|(Atr)|(Obj)|(Sb))/)) {
	    $new_afuns[$x] = modify_subord_verbs_afun($x);
	}
	if (($unify_coap_sfx == 1)&&($z_afuns[$x] =~ /_(Co)|(Ap)$/)) {
	    $new_afuns[$x] = unify_coap_suffixes($z_afuns[$x]);
	}
	if (($in_format eq 'T') && ($z_heads[$x] > 0) &&
	((($z_afuns[$x] eq 'Obj') &&
	(($z_lemmas[$z_heads[$x]] eq 'být') ||
	(($z_tags[$z_heads[$x]] =~ /^R/) && ($z_heads[$z_heads[$x]] > 0) && ($z_lemmas[$z_heads[$z_heads[$x]]] eq 'být'))))||
	(($z_afuns[$x] eq 'Obj_Co') && ($z_afuns[$z_heads[$x]] eq 'Coord') && ($z_heads[$z_heads[$x]] > 0) &&
	(($z_lemmas[$z_heads[$z_heads[$x]]] eq 'být') ||
	(($z_tags[$z_heads[$z_heads[$x]]] =~ /^R/) && ($z_heads[$z_heads[$z_heads[$x]]] > 0) && ($z_lemmas[$z_heads[$z_heads[$z_heads[$x]]]] eq 'být')))))) {
	    remove_byt_obj($x); # Odstraní afun Obj u předmětů přímo závislých na slovese 'být' (max. přes předložku nebo Coord
	}

	my %features;
	if (not defined $tag) { print "TAG UNDEF: $form $lem $INPUT_FILE\n"; }

	if (($form !~ /.+[\-\_\^\`].+/) && ($lem =~  /.+[\-\_\^\`].+/)) {
	    $lem = cut_lemmas_tail($lem);
	}

	# Opravný filtr (chybné tagy / lemmata).
	if ((($form =~ /^[Vv]lastně$/)&&($tag =~ /^Ve/))||(($form =~ /^[Nn]espočet$/)&&($tag =~ /^Vm/))||
	(($form =~ /^((([Jj]eden)|([Dd]va)|([Tt]ři)|([Čč]tyři)|([Pp]ět)|([Šš]est)|([Ss]edm)|([Oo]sm)|([Dd]evět))a)?(([Dd]vace)|([Tt]řice)|([Čč]tyřice)|([Pp]adesá)|([Šš]edesá)|([Ss]edmdesá)|([Oo]smdesá)|([Dd]evadesá))tin.*$/)&&
	($tag =~ /^Cy.P.*/))) {
	    ($form,$lem,$tag) = correction_filter($form,$lem,$tag,$x);
	}

	# Filtr UTKL -> PDT (různé interpretace se zde sjednocují)
	if (defined $UTKL_2_PDT_FILTER_forms{$form}) { ($lem,$tag) = utkl_2_pdt_filter_fo($form); }
	elsif (($form eq '%') || ($form eq '§')) { ($lem,$tag) = utkl_2_pdt_filter_fo($form); }
	elsif (defined $UTKL_2_PDT_FILTER_lemmas{$lem}{substr($tag,0,2)}) { ($lem,$tag) = utkl_2_pdt_filter_le($lem,$tag); }
	elsif (($form =~ /^-?[0-9]+[\.\,\-\:\'\;0-9]*$/) && ($tag =~ /^C[^\=]/)) { ($lem,$tag) = utkl_2_pdt_filter_le($form,$tag); }
	elsif (($form =~ /^[IVXDLCM]+$/)&&($tag =~ /^C[^\{\}\=]/)) { ($lem,$tag) = utkl_2_pdt_filter_le($form,$tag); }
	$tag =~ s/^P7-[SPX]([2-7].+)$/P7--$1/; # Různě zobrazované číslo u reflexiv je irelevantní.

	# Features platné pro všechny slovní druhy...
	# NumGen feature (pokud není "--")
	if ($tag !~ /^..\-\-.+/) { $features{'NumGen'} = substr($tag,2,2);
	    if (($in_format eq 'N') && ($tag =~ /^[APCV][14589delmpswCDHJLOPSWZ][MINF][SP]/)) {
		$features{'NumGen'} = check_numgen_variables($tag,$lem,$form);
	    }
	}
	# Case feature (pokud case != "-")
	if ($tag =~ /^....[1234567X]/) { $features{'Case'} = substr($tag,4,1); }
	# Pers. feature
	if ($tag =~ /^.{7}[123]/) { $features{'Pers'} = substr($tag,7,1); }
	# Abbr. feature (platná pro všechny slovní druhy)
	if ($tag =~ /^.{14}8.?$/) { $features{'Abbr'} = '1'; }
	# Grade feature (pouze 2/3)
	if ($tag =~ /^[AD].{8}[123]/) { $features{'Gr'} = substr($tag,9,1); }

	$pos = substr($tag,0,1);

#	Nouns
	if ($pos eq 'N') {
	    $features{'Synt'} = 'N';
	    my $ng = substr($tag,2,2);

	    if (defined $NOUNS_PERS{$lem}) {
		$features{'NSynt'} = $NOUNS_PERS{$lem};
		if ($NOUNS_PERS{$lem} eq 'N') { $features{'NSynt'}='A'; }
		($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'pers',$x);
	    }
	    elsif ((defined $NOUNS_TOWNS_ON_R{$lem})&&
	    ($x+1<$#z_forms)&&($z_tags[$x+1]=~/^R/)&&($z_tags[$x+2]=~/^N/)&&
	    (defined $NOUNS_TOWNS_ON_R{$lem}{$z_forms[$x+1]}{$z_forms[$x+2]})&&
	    ($NOUNS_TOWNS_ON_R{$lem}{$z_forms[$x+1]}{$z_forms[$x+2]} == 1)) {
		($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'town_on_r',$x);
	    }
	    elsif ((defined $NOUNS_TOWNS{$lem}{$ng})||(($ng =~ /.P$/)&&(defined $NOUNS_TOWNS{$lem}{'P'}))) {
		my $town_type = 'town';
		if ((defined $NOUNS_TOWNS{$lem}{$ng})&&($NOUNS_TOWNS{$lem}{$ng} eq 'C')) {
		    $town_type = 'town_cap';
		}
		($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,$town_type,$x);
		$features{'NSynt'} = 'T';
	    }
	    elsif (exists $NOUNS_MONTHS{$lem}) { ($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'month',$x); }
	    elsif (exists $NOUNS_REG{$lem}) { ($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'reg',$x); }
	    elsif (exists $NOUNS_STATES{$lem}) { ($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'states',$x); }
	    elsif (exists $NOUNS_CARS{$lem}) { ($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'cars',$x); }
	    elsif (($lem =~ /.+násobek$/)&&($tag =~ /^NNI[SP][1-7]/)) { ($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'multiple',$x); }
	    elsif ($lem =~ /^(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?((dvac[eá])|(třic[eá])|(čtyřic[áe])|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))tiny$/) {
		($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'birthday',$x); }
	    elsif ($lem =~ /(((dva)|(tři)|(čtyři))cítka)|(((pa)|(še)|(sedm)|(osm)|(deva))desátka)$/) {
		($lem,$form) = simplify_nominal_lemmas_and_forms($lem,$form,$tag,'tens',$x);
	    }
	    elsif (($lem =~ /^((jeden)|(jedn[ao])|(dva)|(dvě)|(dvou)|(dvoj)|(tř[íi])|(troj)|(čtr)|(čtyř)|(p[aáě]t)|(šest)|(sedm)|(osm)|(dev[ašá]t)|(des[aáe]t)).+/)||
	    ($lem =~ /^(((pade)|(šede)|(sedmde)|(osmde)|(devade)sá)|(sto)|(set)|(tisíc)|(mili[oó]n)).+/)||
	    ($lem =~ /^(([0-9]+)|(několik)|(málo)|(mnoho)|(více)).+/)) {
		($lem, $form) = simplify_quantified_words($lem,$form,$tag);
	    }

	    if (($lem =~ /^[A-ZČĎŇŘŠŤŽÁÉÍÓÚÝ]/)&&((not exists $features{'NSynt'})||(not defined $features{'NSynt'})||($features{'NSynt'} eq ''))) {
		$features{'NSynt'}='N'; } # vlastní jméno
	}

#	Adjectives
	elsif ($pos eq 'A') {
	    if ($tag =~ /^AU/) { ($lem, $form) = simplify_adj_lemmas_and_forms($lem,$form,'AU'); }

#	    elsif ((length($form)>=length($lem))&&
#	    (($lem =~ /^((sto)|(dvěstě)|(třista)|(čtyřista))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)((sekundový)|(vteřinový)|(minutový)|(hodinový)|(denní)|(týdenní)|(měsíční)|(letý)|(procentní)|(členný)|(dílný)|(pruhový)|(hvězdičkový)|(místný)|(ciferný)|(((kilo)|(mili))?gramový)|(tunový)|(kilový)|(litrový)|(hektarový)|(((kilo)|(mili)|(centi))?metrový))$/)||
#	    ($lem =~ /^((jedno)|(dvou)|(tří)|(čtyř)|(pěti)|(šesti)|(sedmi)|(osmi)|(devíti))((sekundový)|(vteřinový)|(minutový)|(hodinový)|(denní)|(týdenní)|(měsíční)|(letý)|(procentní)|(členný)|(dílný)|(pruhový)|(hvězdičkový)|(místný)|(ciferný)|(((kilo)|(mili))?gramový)|(tunový)|(kilový)|(litrový)|(hektarový)|(((kilo)|(mili)|(centi))?metrový))$/)||
#	    ($lem =~ /^[1-9][0-9]*((sekundový)|(vteřinový)|(minutový)|(hodinový)|(denní)|(týdenní)|(měsíční)|(letý)|(procentní)|(členný)|(dílný)|(pruhový)|(hvězdičkový)|(místný)|(ciferný)|(((kilo)|(mili))?gramový)|(tunový)|(kilový)|(litrový)|(hektarový)|(((kilo)|(mili)|(centi))?metrový))$/)||
#	    ($lem =~ /^((sto)|(tisíci)|(několika))((sekundový)|(vteřinový)|(minutový)|(hodinový)|(denní)|(týdenní)|(měsíční)|(letý)|(procentní)|(členný)|(dílný)|(pruhový)|(hvězdičkový)|(místný)|(ciferný)|(((kilo)|(mili))?gramový)|(tunový)|(kilový)|(litrový)|(hektarový)|(((kilo)|(mili)|(centi))?metrový))$/)||
#	    ($lem =~ /^((sto)|(dvouset)|(tříset)|(čtyřset))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)násobný$/)||
#	    ($lem =~ /^((dvoj)|(troj)|(čtyř)|(pěti)|(šesti)|(sedmi)|(osmi)|(devíti)|(deseti)|(několika)|(mnoho)|(více))násobný$/))) {
#		($lem,$form) = simplify_adj_lemmas_and_forms($lem,$form,'QA'); }
#
	    elsif (($tag =~ /^AG/)&&(defined $ADJ_TYPE{$lem})&&($ADJ_TYPE{$lem} eq 'ADJ_REFL')) {
		if (length($form)>=length($lem)) {
		    ($lem, $form) = simplify_adj_lemmas_and_forms($lem,$form,'RA'); }
	    }

	    elsif (($lem =~ /[áaeěiuy][nt]ý$/)&&(defined $ADJ_TYPE{$lem})&&($ADJ_TYPE{$lem} =~ /^ADJ_NT/)) {
#		print "AdjNT: $lem : $ADJ_TYPE{$lem}\n";
		if (length($form)>=length($lem)) {
		    ($lem, $form) = simplify_adj_lemmas_and_forms($lem,$form,'NT'); }
	    }

	    elsif ((defined $ADJ_TYPE{$lem})&&($ADJ_TYPE{$lem} =~ /^clr/)) {
	        ($lem, $form) = simplify_adj_lemmas_and_forms($lem,$form,$ADJ_TYPE{$lem}); 
	    }

	    elsif (($lem =~ /^((jeden)|(jedn[ao])|(dva)|(dvě)|(dvou)|(dvoj)|(tř[íi])|(troj)|(čtr)|(čtyř)|(p[aáě]t)|(šest)|(sedm)|(osm)|(dev[ašá]t)|(des[aáe]t)).+/)||
	    ($lem =~ /^(((pade)|(šede)|(sedmde)|(osmde)|(devade)sá)|(sto)|(set)|(tisíc)|(mili[oó]n)).+/)||
	    ($lem =~ /^(([0-9]+)|(několik)|(málo)|(mnoho)|(více)).+/)) {
		($lem, $form) = simplify_quantified_words($lem,$form,$tag);
	    }



	    if ($lem =~ /^(každý)|(další)|(mnohý)|(možný)|(mladý)|(starý)|(ostatní)|(známý)|(druhý)|(poslední)|(cestující)|(věřící)|(raněný)|(umírající)$/) {
		$features{'Synt'} = 'a'; }
	    elsif ($tag =~ /^AC/) { $features{'Synt'} = 'C'; }
	    else { $features{'Synt'} = 'A'; }

	    if ((exists $ADJ_TYPE{$lem})&&($tag !~ /^A.+8.?$/)) {
		($lem, $form) = simplify_adj_lemmas_and_forms($lem,$form,$ADJ_TYPE{$lem});
	    }
	    elsif (($lem =~ /^(jiho)|(severo)|(východo)|(západo).+ský$/) && ($tag !~ /^A.+8$/)) {
		my $lempart = $lem; $lempart =~ s/^jiho(.+ský)$/$1/; $lempart =~ s/^severo(.+ský)$/$1/;
		$lempart =~ s/^východo(.+ský)$/$1/; $lempart =~ s/^západo(.+ský)$/$1/;
		if (defined $ADJ_TYPE{$lempart}) {
		    ($lem, $form) = simplify_adj_lemmas_and_forms($lem,$form,'r'); }
	    }
	}

#	Pronouns
	elsif ($pos eq 'P') {
	    $tag =~ s/^P7-[SPX]([2-7].+)$/P7--$1/;
	    my ($synt_f, $psynt_f) = pronoun_features($lem, $tag);
	    $features{'Synt'} = $synt_f;
	    if ($psynt_f ne '-') { $features{'PSynt'} = $psynt_f; }
	    if (($tag =~ /^P[SDZ].+/)&&
	    (($tag =~ /^PS.....1/)||($lem =~ /.+ten$/)||($lem =~ /^ten.+/)||
	    ($lem =~ /.+((si)|(koliv?))$/)||($lem =~ /^((lec)|(leda)|(ledas)|(kde)|(sotva)|(málo)|(zřídka)|(bůhví)|(čertví)).+/))) {
		($form,$lem) = simplify_pronouns_lemmas_and_forms($form,$lem,$tag);
	    }
	    if ($tag =~ /^PS.....1/) { $features{'Pers'} = '2'; } # Zjednodušení osoby u posesiv (1==2)
	}

#	Numerals
	elsif ($pos eq 'C') {
	    my $synt_f;
	    ($form,$lem,$synt_f) = simplify_numbers_lemmas_and_forms_and_get_features($form,$lem,$tag,$x);
	    $features{'Synt'} = $synt_f;
	}
	elsif ($pos eq 'V') {
	    $features{'Synt'} = 'V';
	    my $vform = substr($tag,1,1);
	    if ($vform eq 't') { $vform = 'B'; $form =~ s/^(.+)ť$/$1/; }
	    if ($vform eq 'B') { $vform = substr($tag,8,1); if ($vform eq '-') { $vform = 'P';} }
	    if ($vform eq 'q') { $vform = 'p'; $form =~ s/^(.+)ť$/$1/; }
	    elsif ($vform eq 'm') { $vform = 'e'; }

	    $features{'VForm'} = $vform;
#	    $features{'Synt'} = $vform;

	    if (($lem =~ /[aie]t$/)&&(defined $VERBS_simp{$lem})) {
		($form,$lem) = simplify_verbs_forms_and_lemmas($form,$lem,$tag);
	    }
	    if ((($tag =~ /^Vf/)&&($form =~ /(ct)|(ti)$/))|| # moct, psáti
	    (($tag =~ /^VB\-[SP]\-\-\-[13]/)&&
	    ((($form =~ /jo?u$/) && ($lem =~ /((ova)|(ou)|[ýíá])t$/))|| # kupuju, kryjou
	    (($form =~ /[šžč][ií]$/)&&($lem =~ /[szk][aá]t$/))))) { # píši, táží
    		$form = unify_formal_variants_of_verbs($form,$lem,$tag);
	    }
	}

	elsif ($pos eq 'D') {
	    $features{'Synt'} = 'D';
#	Predikativa??? líto,smutno,veselo,zapotřebí,načase,nabíledni,nanic,zatěžko,teplo,horko,chladno,zima,tma,škoda,hanba,radost,veta,fuk
	    if (exists $ADV_TYPE{$lem}) {
		($form,$lem) = simplify_adv_forms_and_lemmas($form,$lem);
	    }
	    elsif ($lem =~ /^napo((prvé)|(druhé)|(třetí)|(čtvrté)|(páté)|(šesté)|(sedmé)|(osmé)|(deváté)|(desáté)|(.+nácté)|(.+cáté)|(.+desáté))$/) {
		($form,$lem) = simplify_adv_forms_and_lemmas($form,$lem);
	    }
	    elsif (($lem =~ /^((sto)|(dvouset)|(tříset)|(čtyřset))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)násobně$/)||
	    ($lem =~ /^((několika)|(mnoho)|(více)|(dvoj)|(troj)|(čtyř)|(pěti)|(šesti)|(sedmi)|(osmi)|(devíti)|(deseti)|(několika)|(mnoho)|(více)|(sto)|(tisíci))násobně$/)) {
		($form,$lem) = simplify_adv_forms_and_lemmas($form,$lem);
	    }
	    elsif (($lem =~ /^((kde)|(kam)|(kudy)|(odkud)|(kdy)|(jak))koliv?$/)||
	    ($lem =~ /^((lec)|(leda)|(ledas)|(kde)|(sotva)|(málo)|(zřídka)|(bůhví)|(čertví))((kde)|(kam)|(kudy)|(odkud)|(kdy)|(jak)|(kolik))$/)) {
		($form,$lem) = simplify_adv_forms_and_lemmas($form,$lem);
	    }
	    elsif (($lem =~ /^((jeden)|(jedn[ao])|(dva)|(dvě)|(dvou)|(dvoj)|(tř[íi])|(troj)|(čtr)|(čtyř)|(p[aáě]t)|(šest)|(sedm)|(osm)|(dev[ašá]t)|(des[aáe]t)).+/)||
	    ($lem =~ /^(((pade)|(šede)|(sedmde)|(osmde)|(devade)sá)|(sto)|(set)|(tisíc)|(mili[oó]n)).+/)||
	    ($lem =~ /^(([0-9]+)|(několik)|(málo)|(mnoho)|(více)).+/)) {
		($lem, $form) = simplify_quantified_words($lem,$form,$tag);
	    }
	}
	elsif ($pos eq 'R') { $features{'Synt'} = 'R';
#	Složené předložky???
	    if (($form eq 's') && ($x<$#z_forms)&&($z_forms[$x+1] eq 'to')) {
		my $byt_s_to = s_to($x);
		if ($byt_s_to == 2) { next; }
	    }
	    if ($tag =~ /^RV/) {
		$form = simplify_vocalised_prepositions($form, $lem);
	    }
	}
	elsif ($pos eq 'J') { $features{'Synt'} = substr($tag,1,1); }
	elsif ($pos eq 'Z') {
	    if (($form ne '-')||($x == $#z_forms)||($z_forms[$x+1] ne 'li')) {
		$features{'Synt'} = 'Z'; }
	    else { $features{'Synt'} = 'l'; }
	}
	else { $features{'Synt'} = $pos; }

	my $feature = '';
	foreach my $ftype ('Synt', 'VForm', 'PSynt', 'NSynt', 'NumGen', 'Case', 'Pers', 'Gr', 'Abbr', 'CPrep') {
	    if (defined $features{$ftype}) {
		if ($feature eq '') { $feature = $ftype . '=' . $features{$ftype}; }
		else  { $feature .= '|' . $ftype . '=' . $features{$ftype}; }
	    }
	}

	if ($simplify_forms == 0) { ($form,$lem) = ($z_forms[$x], $z_lemmas[$x]);
	    if (($form !~ /.+[\-\_\^\`].+/) && ($lem =~  /.+[\-\_\^\`].+/)) {
		$lem = cut_lemmas_tail($lem); }
	    # Filtr UTKL -> PDT
	    if (defined $UTKL_2_PDT_FILTER_forms{$form}) { ($lem,$tag) = utkl_2_pdt_filter_fo($form); }
	    elsif (($form eq '%') || ($form eq '§')) { ($lem,$tag) = utkl_2_pdt_filter_fo($form); }
	    elsif (defined $UTKL_2_PDT_FILTER_lemmas{$lem}{substr($tag,0,2)}) { ($lem,$tag) = utkl_2_pdt_filter_le($lem,$tag); }
	    elsif (($form =~ /^-?[0-9]+[\.\,\-\:\'\;0-9]*$/) && ($tag =~ /^C[^\=]/)) { ($lem,$tag) = utkl_2_pdt_filter_le($form,$tag); }
	    elsif (($form =~ /^[IVXDLCM]+$/)&&($tag =~ /^C[^\{\}\=]/)) { ($lem,$tag) = utkl_2_pdt_filter_le($form,$tag); }
	}
	elsif ($simplify_forms == 2) {
	    ($form,$lem) = ($z_forms[$x], $z_lemmas[$x]);
	    if (($form !~ /.+[\-\_\^\`].+/) && ($lem =~  /.+[\-\_\^\`].+/)) {
		$lem = cut_lemmas_tail($lem); }
	    # Filtr UTKL -> PDT
	    if (defined $UTKL_2_PDT_FILTER_forms{$form}) { ($lem,$tag) = utkl_2_pdt_filter_fo($form); }
	    elsif (($form eq '%') || ($form eq '§')) { ($lem,$tag) = utkl_2_pdt_filter_fo($form); }
	    elsif (defined $UTKL_2_PDT_FILTER_lemmas{$lem}{substr($tag,0,2)}) { ($lem,$tag) = utkl_2_pdt_filter_le($lem,$tag); }
	    elsif (($form =~ /^-?[0-9]+[\.\,\-\:\'\;0-9]*$/) && ($tag =~ /^C[^\=]/)) { ($lem,$tag) = utkl_2_pdt_filter_le($form,$tag); }
	    elsif (($form =~ /^[IVXDLCM]+$/)&&($tag =~ /^C[^\{\}\=]/)) { ($lem,$tag) = utkl_2_pdt_filter_le($form,$tag); }

	    if (($tag =~ /^C\=/)||($tag =~ /^C=/)||(($pos eq 'C') && ($form =~ /^\-?[0-9]+[\.\,]?[0-9]*$/))) {
		($form,$lem) = ('<num>','<num>'); }
	}

	($new_forms[$x], $new_lemmas[$x], $new_tags[$x]) = ($form, $lem, $tag);
	$z_features[$x] = $feature;
	if ($zeman_like_conll_features == 1) { $z_features[$x] = create_zeman_like_conll_features($tag);}
	if (defined $features{'Synt'}) { $synt_features[$x] = $features{'Synt'}; }
	else { $synt_features[$x] = $pos; }
    }
}

# ==============================================================================

# --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# --- --- Podprogramy pro jednotlivé slovní druhy --- ---
# --- --- --- --- --- --- --- --- --- --- --- --- --- ---

sub simplify_nominal_lemmas_and_forms {
    my ($nlem,$nform,$ntag,$ntype,$n_ord) = @_;

    if ($ntype eq 'pers') {
	my ($gen,$nucase) = (substr($ntag,2,1), substr($ntag,3,2));
	if ($ntag !~ /^NN[MF][SP][1234567]/) { return ($nlem, $nform); }
	if ((defined $NOUNS_PERS{$nlem})&&($NOUNS_PERS{$nlem} =~ /^[PG]$/)) {
	    if (($NOUNS_PERS{$nlem} eq 'P')&&($gen eq 'M')) {
		$nlem = 'Novák'; $nform = $CONVERT_FORMS{'Novák'}{$nucase}; }
	    elsif (($NOUNS_PERS{$nlem} eq 'P')&&($gen eq 'F')) {
		$nlem = 'Nováková'; $nform = $CONVERT_FORMS{'Nováková'}{$nucase}; }
	    elsif (($NOUNS_PERS{$nlem} eq 'G')&&($gen eq 'M')) {
		$nlem = 'Jan'; $nform = $CONVERT_FORMS{'Jan'}{$nucase}; }
	    elsif (($NOUNS_PERS{$nlem} eq 'G')&&($gen eq 'F')) {
		$nlem = 'Alena'; $nform = $CONVERT_FORMS{'Alena'}{$nucase}; }
	}
	elsif ((defined $NOUNS_PERS{$nlem}) && ($NOUNS_PERS{$nlem} eq 'N')) {
	    if ($gen eq 'M') {
		$nlem = 'Polák'; $nform = $CONVERT_FORMS{'Polák'}{$nucase}; }
	    elsif ($gen eq 'F') {
		$nlem = 'Polka'; $nform = $CONVERT_FORMS{'Polka'}{$nucase}; }
	}
    }
    elsif ($ntype =~ /^town(\_cap)?$/) {
	my ($gen,$nucase) = (substr($ntag,2,1), substr($ntag,3,2));
	if ($nucase !~ /^[SP][1234567]$/) { return ($nlem, $nform); }
	elsif ($nucase =~ /^P/) {
	    $nlem = 'Pardubice'; $nform = $CONVERT_FORMS{'Pardubice'}{$nucase}; }
	elsif (($gen eq 'F')&&($ntype eq 'town_cap')) {
	    $nlem = 'Praha'; $nform = $CONVERT_FORMS{'Praha'}{$nucase}; }
	elsif ($gen eq 'F') {
	    $nlem = 'Jihlava'; $nform = $CONVERT_FORMS{'Jihlava'}{$nucase}; }
	elsif (($gen eq 'I')&&($ntype eq 'town_cap')) {
	    $nlem = 'Londýn'; $nform = $CONVERT_FORMS{'Londýn'}{$nucase}; }
	elsif ($gen eq 'I') {
	    $nlem = 'Kolín'; $nform = $CONVERT_FORMS{'Kolín'}{$nucase}; }
	elsif (($gen eq 'N')&&($ntype eq 'town_cap')) {
	    $nlem = 'Oslo'; $nform = $CONVERT_FORMS{'Oslo'}{$nucase}; }
	elsif ($gen eq 'N') {
	    $nlem = 'Brno'; $nform = $CONVERT_FORMS{'Brno'}{$nucase}; }
    }
    elsif ($ntype eq 'town_on_r') {
	if ($ntag !~ /^NN[NIF][SP][1-7]/) { return ($nlem, $nform); }
	my ($gen,$num,$case)=(substr($ntag,2,1), substr($ntag,3,1), substr($ntag,4,1));
	my @town_forms; my ($new_prep, $new_river_hill);
	if ($num eq 'P') { @town_forms = (qw(nic Paseky Pasek Pasekám Paseky Paseky Pasekách Pasekami)); }
	elsif ($gen eq 'N') { @town_forms = (qw(nic Jablonné Jablonného Jablonnému Jablonné Jablonné Jablonném Jablonným)); }
	elsif ($gen eq 'F') { @town_forms = (qw(nic Lysá Lysé Lysé Lysou Lysá Lysé Lysou)); }
	elsif ($gen eq 'I') { @town_forms = (qw(nic Rožnov Rožnova Rožnovu Rožnov Rožnov Rožnově Rožnovem)); }
	else { return ($nlem,$nform); }
	($nlem,$nform) = ($town_forms[1], $town_forms[$case]);
	if ($allow_chunking==0) {
	    $new_forms[$n_ord+1]='nad'; $new_lemmas[$n_ord+1]='nad';
	    $new_forms[$n_ord+2]='Labem'; $new_lemmas[$n_ord+2]='Labe';
	    $ch_forms[$n_ord+1]='nad'; $ch_lemmas[$n_ord+1]='nad';
	    $ch_forms[$n_ord+2]='Labem'; $ch_lemmas[$n_ord+2]='Labe';
	}
	else {
	    remove_item_while_chunking($n_ord+1);
	    remove_item_while_chunking($n_ord+2);
	    $nform .= '_nad_Labem'; $nlem .= '_nad_Labem';
	    if ($in_format eq 'N') {
		$recover_chunking[$n_ord]='CHUNKING:REG';
		$recover_chunking[$n_ord+1]='AuxP:-1';
		$recover_chunking[$n_ord+2]='Atr:-1';
	    }
	}
    }
    elsif ($ntype eq 'reg') {
	$ntype = $NOUNS_REG{$nlem};
	my ($lemlen,$formlen) = (length($nlem),length($nform));
	my $sufx = substr($nform,$lemlen-3);
	if ($ntype eq 'c') {
	    $nlem = 'Plzeňsko'; $nform = 'Plzeň' . $sufx;
	}
	elsif ($ntype eq 'i') {
	    $nlem = 'Bavorsko'; $nform = 'Bavor' . $sufx;
	}
    }
    elsif ($ntype eq 'states') {
	$ntype = $NOUNS_STATES{$nlem};
	my ($gennum,$nucase) = (substr($ntag,2,2), substr($ntag,3,2));
	if ($nucase !~ /^[SP][1234567]$/) { return ($nlem, $nform); }
	if (($ntype eq 'FS.C') && ($gennum eq 'FS')) {
	    $nlem = 'Evropa'; $nform = $CONVERT_FORMS{'Malta'}{$nucase}; $nform =~ s/^Malt/Evrop/; }
	elsif (($gennum eq 'FP') && ($ntype eq 'FP')) {
	    $nlem = 'Filipíny'; $nform = $CONVERT_FORMS{'Filipíny'}{$nucase}; }
	elsif (($gennum eq 'IS')&&($ntype eq 'IS')) {
	    $nlem = 'Island'; $nform = $CONVERT_FORMS{'Island'}{$nucase}; }
	elsif (($gennum eq 'NS') && ($ntype eq 'NS')) {
	    $nlem = 'Česko'; $nform = $CONVERT_FORMS{'Česko'}{$nucase}; }
	elsif (($gennum eq 'FS')&&($ntype eq 'FS')) {
	    $nlem = 'Malta'; $nform = $CONVERT_FORMS{'Malta'}{$nucase}; }
    }
    elsif ($ntype eq 'cars') {
	$ntype = $NOUNS_CARS{$nlem};
	if ($ntype eq (substr($ntag,2,1))) {
	    my ($lemlen,$formlen) = (length($nlem),length($nform));
	    my $sufx = '';
	    if ($ntype eq 'F') {
		if ($formlen>=$lemlen) {
		    $sufx = substr($nform,$lemlen-1);
		    $nlem = 'Škoda'; $nform = 'Škod' . $sufx;
		}
	    }
	    elsif ($ntype eq 'I') {
		if ($formlen>$lemlen) { $sufx = substr($nform,$lemlen); }
		$nlem = 'Opel'; $nform = 'Opel' . $sufx;
	    }
	}
    }
    elsif ($ntype eq 'month') {
	my $nucase = substr($ntag,3,2);
	if ($nucase !~ /^[SP][1234567]$/) { return ($nlem, $nform); }
	else {
	    $nlem = 'únor';
	    my $monthform = $CONVERT_FORMS{'únor'}{$nucase};
	    if ($nform  =~ /^[A-ZČĎŇŘŠŤŽÁÉÍÓÚÝ]/) {
		$nform = 'Ú' . substr($monthform,1); }
	    else { $nform = $monthform; }
	}
    }
    elsif ($ntype eq 'multiple') {
	my ($lemlen,$formlen) = (length($nlem),length($nform));
	my $sufx = substr($nform,$lemlen-2);

	if ($nform =~ /^[A-ZČĎŇŘŠŤŽ].+/) { $nform = 'P'; }
	else { $nform = 'p'; }
	$nlem = 'pětinásobek';
	$nform .= 'ětinásob' . $sufx;
    }
    elsif ($ntype eq 'tens') {
	my ($lemlen,$formlen) = (length($nlem),length($nform));
	my $sufx = substr($nform,$lemlen-2);
	my $newnform;
	if ($nform =~ /^[A-ZČĎŇŘŠŤŽ].+/) { $newnform = 'D'; }
	else { $newnform = 'd'; }
	if ($nlem =~ /^((dva)|(tři)|(čtyři)cítka)|((pa)|(še)|(sedm)|(osm)|(deva)desátka)$/) {
	    $nlem = 'dvacítka'; $nform = $newnform . 'vacít' . $sufx; 
	}
	elsif ($nlem =~ /^((sto)|(dvěstě)|(třista)|(čtyřista)|(pětset))?(((jeden)|(jedn)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?((dvac)|(třic)|(čtyřic)ítka)|((pa)|(še)|(sedm)|(osm)|(deva)desátka)$/) {
	    $nlem = 'dvaadvacítka'; $nform = $newnform . 'vaadvacít' . $sufx;
	}
    }
    elsif ($ntype eq 'birthday') {
    	my ($lemlen,$formlen) = (length($nlem),length($nform));
	my $sufx = substr($nform,$lemlen-2);
	if ($nform =~ /^[A-ZČĎŇŘŠŤŽ].+/) { $nform = 'P'; }
	else { $nform = 'p'; }
	$nform .= 'adesáti' . $sufx;
	$nlem = 'padesátiny';
    }
    return ($nlem, $nform);
}

sub simplify_adj_lemmas_and_forms {
    my ($alem,$aform,$atype) = @_;
    my ($lemlen,$formlen) = (length($alem),length($aform));
    my ($formcap,$lemcap) = (0,0);
    if ($aform =~ /^[A-ZČĎŇŘŠŤŽÍÚ].+/) { $formcap = 1; }
    if ($alem =~ /^[A-ZČĎŇŘŠŤŽÍÚ].+/) { $lemcap = 1; }

    if ($atype eq 'AU') {
	if ($alem =~ /.+ův$/) { $atype = 'uv'; }
	elsif ($alem =~ /.+in$/) { $atype = 'in'; }
	else { return ($alem, $aform); }
	my $sufx = '';
	if (length($aform)>$lemlen-2) {
	    $sufx = substr($aform,$lemlen-2,$formlen-$lemlen+2); }
	if ($lemcap) {
	    if ($atype eq 'uv') { $alem = 'Petrův'; $aform = 'Petr' . $sufx; }
	    else { $alem = 'Petřin'; $aform = 'Petř' . $sufx; }
	}
	elsif ($formcap) {
	    if ($atype eq 'uv') { $alem = 'otcův'; $aform = 'Otc' . $sufx; }
	    else { $alem = 'matčin'; $aform = 'Matč' . $sufx; }
	}
	else {
    	    if ($atype eq 'uv') { $alem = 'otcův'; $aform = 'otc' . $sufx; }
	    else { $alem = 'matčin'; $aform = 'matč' . $sufx; }
	}
    }
    elsif ($atype eq 'QA') {
	my $sufx = substr($aform,$lemlen-1,$formlen-$lemlen+1);
	if ($formcap) { $aform = 'X'; } else { $aform = 'x'; }
	if ($alem =~ /((sekundový)|(vteřinový)|(minutový)|(hodinový)|(letý))$/) {
	    $alem = 'xxletý'; $aform .= 'xlet'; }
	elsif ($alem =~ /((denní)|(týdenní)|(měsíční))$/) {
	    $alem = 'xxdenní'; $aform .= 'xdenn'; }
	elsif ($alem =~ /((((kilo)|(mili))?gramový)|(tunový)|(kilový))$/) {
	    $alem = 'xxkilový'; $aform .= 'xkilov'; }
	elsif ($alem =~ /((((kilo)|(mili)|(centi))?metrový))$/) {
	    $alem = 'xxmetrový'; $aform .= 'xmetrov'; }
	elsif ($alem =~ /násobný$/) {
	    $alem = 'xxnásobný'; $aform .= 'xnásobn'; }
	elsif ($alem =~ /(procentní)|(členný)|(dílný)|(pruhový)|(hvězdičkový)|(místný)|(ciferný)|(litrový)|(hektarový)$/) {
	    $alem =~ s/^.+((procentní)|(členný)|(dílný)|(pruhový)|(hvězdičkový)|(místný)|(ciferný)|(litrový)|(hektarový))$/x$1/;
	    $aform = substr($alem, 0, length($alem)-1);
	}
	$aform .= $sufx;
    }
    elsif ($atype eq 'NT') {
	my $sufx = substr($aform,$lemlen-1,$formlen-$lemlen+1);
	my $prefx = 'p'; if ($formcap) { $prefx = 'P'; }
	if ($ADJ_TYPE{$alem} eq 'ADJ_NT_AGENS') {
	    $alem = 'podporovaný'; $aform = $prefx . 'odporovan' . $sufx; }
	elsif ($ADJ_TYPE{$alem} eq 'ADJ_NT_OBJ') {
	    $alem = 'pověřený'; $aform = $prefx . 'ověřen' . $sufx; }
	else { $alem = 'postižený'; $aform = $prefx . 'ostižen' . $sufx; }
    }
    elsif ($atype eq 'RA') {
	my $sufx = substr($aform,$lemlen-1,$formlen-$lemlen+1);
	my $newlem = $ADJ_REFL{$alem};
	if ($formcap) { $aform = uc(substr($newlem,0,1)) . substr($newlem,1,length($newlem)-2) . $sufx; }
	else { $aform = substr($newlem,0,length($newlem)-1) . $sufx; }
	$alem = $newlem;
    }
    elsif (($atype =~ /^[tnrm]$/)&&($formlen>$lemlen-2)) {
	my $sufx = substr($aform,$lemlen-3);
	($aform,$alem) = ('p','p');
	if ($formcap) { $aform = 'P'; }
	if ($lemcap) { $alem = 'P'; }
	if ($atype eq 't') { $aform .= 'raž'; $alem .= 'ražský'; }
	elsif ($atype eq 'n') { $aform .= 'ol'; $alem .= 'olský'; }
	elsif ($atype eq 'm') { $aform .= 'olsko-ru'; $alem .= 'olsko-ruský'; }
	else { $aform .= 'olab'; $alem .= 'olabský'; }
	$aform .= $sufx;
    }
    elsif (($atype =~ /^clr0?$/)&&($formlen>$lemlen-1)) {
	my $sufx = '';
	if (length($aform)>$lemlen-1) {
	    $sufx = lc(substr($aform,$lemlen-1)); }
	if ($atype eq 'clr0') { $alem = 'bílý'; $aform = 'bíl'; }
	else { $alem = 'modrý'; $aform = 'modr'; }
	if ($formcap) { $aform = uc(substr($aform,0,1)) . substr($aform,1); }
	$aform .= $sufx;
    }
    elsif ($atype eq 'ici') {
	my $sufx = '';
	if (length($aform)>$lemlen-1) {
	    $sufx = lc(substr($aform,$lemlen-1)); }
	$alem = $ADJ_VRB_REPL{$alem};
	$aform = substr($alem,0,length($alem)-1) . $sufx;
	if ($formcap) { $aform = uc(substr($aform,0,1)) . substr($aform,1); }
    }
    elsif ($atype eq 'ny') {
	my $sufx = '';
	if (length($aform)>$lemlen-1) {
	    $sufx = lc(substr($aform,$lemlen-1)); }
	$alem = $ADJ_VRB_REPL{$alem};
	$aform = substr($alem,0,length($alem)-1) . $sufx;
	if ($formcap) { $aform = uc(substr($aform,0,1)) . substr($aform,1); }
    }
    return ($alem, $aform);
}

sub pronoun_features {
    my ($plem, $ptag) = @_;
    my ($a_synt, $a_psynt) = ('a', '-'); # obecná synt. feature (Synt) a specifická zájmenná (PSynt)
    if ($ptag =~ /^P[67]/) { $a_psynt='Rflx'; }
    elsif ($ptag =~ /^P[9J4]/) { $a_psynt='Rel'; }
    elsif ($ptag =~ /^P1/) { $a_psynt='PosRel'; }
    elsif ($ptag =~ /^PE/) { $a_psynt='CooRel'; }

    if (($ptag =~ /^P[HJKPQ5679]/)||
    (($ptag =~ /^PW/) && (($plem eq 'nic') || ($plem eq 'nikdo'))) ||
    (($ptag =~ /^PZ/) && (($plem =~ /cos?$/) || ($plem =~ /kdos?$/) || ($plem =~ /^co/) || ($plem =~ /^kdo/)))) {
	$a_synt = 'P'; }
    elsif ((($ptag =~ /^PD/)&&(($plem eq 'ten')||($plem eq 'to'))) ||
    (($ptag =~ /^PLMP/)&&(($plem eq 'všechen')||($plem eq 'všichni'))) ||
    (($ptag =~ /^PLNS/)&&(($plem eq 'všechen')||($plem eq 'všechno'))) ||
    (($ptag =~ /^P4/)&&($plem eq 'který'))) {
    	$a_synt = 'p'; }
    elsif ($plem =~ /^(jakýkoli)|(jakýsi)|(takový)|(lecjaký)|(kdovíjaký)|(něčí)$/) {
	$a_synt = 'A'; }
    return ($a_synt, $a_psynt);
}

sub simplify_pronouns_lemmas_and_forms {
    my ($pform, $plem, $ptag) = @_;
    if ($ptag =~ /^PS....[PS]1/) {
	if (($plem eq 'můj')||($plem eq 'náš')) {
	    $plem = 'tvůj';
	    $pform =~ s/^M([áéíoůýÁÉÍOŮÝ].+)$/Tv$1/; $pform =~ s/^m([áéíoůýÁÉÍOŮÝ].+)$/tv$1/;
	    $pform =~ s/^N([aáAÁ][šŠ].*)$/V$1/; $pform =~ s/^n([aáAÁ][šŠ].*.+)$/v$1/;
	}
    }
    elsif ($ptag =~ /^PD/) {
	if ($plem =~ /^ten((to)|(hle)|(dle))$/) {
	    $plem = 'tento';
	    $pform =~ s/^(.+)((to)|(hle)|(dle))$/$1to/;
	}
	elsif ($plem =~ /^((tam)|(tady)|(tamhle)|(tuhle)|(tudle)|(tadyhle))ten$/) {
	    $plem = 'tamten';
	    $pform =~ s/^([Tt])((am)|(ady)|(amhle)|(uhle)|(udle)|(adyhle))(.+)$/$1am$+/;
	}
    }
    elsif ($ptag =~ /^PZ/) {
	if ($plem =~ /^((jaký)|(který)|(čí)|(co)|(kdo))koliv?$/) {
	    $plem =~ s/^(.+)koliv?$/$1si/;
	    $pform =~ s/^(.+)koliv?$/$1si/;
	}
	elsif ($plem =~ /^((lec)|(leda)|(ledas)|(kde)|(sotva)|(málo)|(zřídka)|(bůhví)|(čertví))((jaký)|(který)|(čí)|(co)|(cos)|(kdo))$/) {
	    $plem =~ s/((lec)|(ledas)|(leda)|(kde)|(sotva)|(málo)|(zřídka)|(bůhví)|(čertví))(.+)$/$+si/;
	    my $ucform = $pform;
	    $pform =~ s/(([Ll]ec)|([Ll]edas)|([Ll]eda)|([Kk]de)|([Ss]otva)|([Mm]álo)|([Zz]řídka)|([Bb]ůhví)|([Čč]ertví))(.+)$/$+si/;
	    if ($ucform =~ /^[A-ZČ].+/) { $pform = uc(substr($pform,0,1)) . substr($pform,1); }
	}
    }
    return ($pform, $plem);
}

sub simplify_numbers_lemmas_and_forms_and_get_features {
# num.5+(5), num.synt.subst.(n), num.synt.adj.(c), num.1234 (l), num.graf. (9), num.part.(y)
    my ($nform, $nlem, $ntag,$indx) = @_;
    my $nfeat;
    my ($lemlen,$formlen) = (length($nlem),length($nform));
    my $formcap = 0;
    if ($nform =~ /^[A-ZČĎŇŘŠŤŽ].+/) { $formcap = 1; }

    if ($ntag =~ /^Cl/) {
	if ($nlem =~ /^(sto)|(dvěstě)|(tisíc)|(půl)|(pár)$/) { $nfeat = 'n'; }
	else { $nfeat = 'l'; }
    }
    elsif ($ntag =~ /^C[vo]/) {
	if ($nform =~ /.+[Kk][Rr][Áá][Tt]$/) {
	    if ($formcap) { $nform = 'Xkrát'; }
	    else { $nform = 'xkrát'; }
	    $nlem = 'xkrát';
	}
	elsif ($nform =~ /^[Pp][Oo].+[Éé]$/) {
	    if ($formcap) { $nform = 'Poxté'; }
	    else { $nform = 'poxté'; }
	    $nlem = 'poxté';
	}
	$nfeat = 'D';
    }
    elsif ($ntag =~ /^Cn/) {
	if ($ntag =~ /^Cn..[145]/) { $nfeat = '5'; }
	else {$nfeat = 'c'; }

	if ($nlem =~ /^(pět)|(šest)|(sedm)|(osm)|(devět)$/) {
	    $nlem = 'pět';
	    if ($formcap) { $nform = 'Pět'; }
	    else { $nform = 'pět'; }
	    if ($nform =~ /.+[Ii]$/) { $nform .= 'i'; }
	}
	elsif ($nlem =~ /^(dvacet)|(třicet)|(čtyřicet)|(padesát)|(šedesát)|(sedmdesát)|(osmdesát)|(devadesát)$/) {
	    $nlem = 'třicet';
	    if ($formcap) { $nform = 'Třicet'; }
	    else { $nform = 'třicet'; }
	    if ($nform =~ /.+[Ii]$/) { $nform .= 'i'; }
	}
	elsif (($nlem =~ /^(deset)|(jedenáct)|(dvanáct)|(třináct)|(čtrnáct)|(patnáct)|(šestnáct)|(sedmnáct)|(osmnáct)|(devatenáct)$/) ||
	($nlem =~ /^((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set))?((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a((dvacet)|(třicet)|(čtyřicet)|(padesát)|(šedesát)|(sedmdesát)|(osmdesát)|(devadesát))$/)||
	($nlem =~ /^((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set))?((dvacet)|(třicet)|(čtyřicet)|(padesát)|(šedesát)|(sedmdesát)|(osmdesát)|(devadesát))((jedna)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))$/)) {
	    $nlem = 'třináct';
	    if ($formcap) { $nform = 'Třináct'; }
	    else { $nform = 'třináct'; }
	    if ($nform =~ /.+[Ii]$/) { $nform .= 'i'; }
	}
    }
    elsif ($ntag =~ /^Cr/) {
	$nfeat = 'a';
	if (($nlem =~ /^(pát)|(šest)|(sedm)|(osm)|(devát)ý$/) ||
	($nlem =~ /^(desát)|(jedenáct)|(dvanáct)|(třináct)|(čtrnáct)|(patnáct)|(šestnáct)|(sedmnáct)|(osmnáct)|(devatenáct)ý$/) ||
	($nlem =~ /^(dvacát)|(třicát)|(čtyřicát)|(padesát)|(šedesát)|(sedmdesát)|(osmdesát)|(devadesát)ý$/) ||
	($nlem =~ /^((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set))?((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a((dvacát)|(třicát)|(čtyřicát)|(padesát)|(šedesát)|(sedmdesát)|(osmdesát)|(devadesát))ý$/)) {
	    if (($formlen >= $lemlen)&&($lemlen>2)) {
		my ($sufx_start,$sufx_len) = ($lemlen-1, $formlen-$lemlen+1);
		my $sufx = substr($nform,$sufx_start,$sufx_len);
		$nlem = 'pátý';
		if ($formcap) { $nform = 'Pát'; }
		else { $nform = 'pát'; }
		$nform .= $sufx;
	    }
	}
    }
    elsif ($ntag =~ /^C[\=\{\}]/) {
	$nfeat = '9';
	if ($nlem !~ /^0*[1234]$/) {
	    if (($indx < 2) ||
	    ($nlem !~ /^((1[0-9])|(2[0-1])|[1-9])[0-9][0-9]$/)||
	    (($z_lemmas[$indx-1] ne 'rok')&&($z_lemmas[$indx-1] ne 'září')&&(not defined $NOUNS_MONTHS{$z_lemmas[$indx-1]})&&
	    (($indx < 3)||($z_lemmas[$indx-1] ne '.')||($z_lemmas[$indx-2] !~ /^(1[012])|([1-9])$/)))) {
		$nlem = '123'; $nform = '123';
	    }
	    else {
		$nlem = '1984'; $nform = '1984'; }
	}
	elsif ($nlem =~ /^0*[234]$/) {
	    $nlem = '2'; $nform = '2'; }
	else { $nlem = '1'; $nform = '1'; }
    }
    elsif ($ntag =~ /^C[a\?]/) { $nfeat = 'n'; }
    elsif ($ntag =~ /^Cw/) {
	$nfeat = 'a';
	if ($nlem =~ /kolikátý$/) {
	    $nlem = 'pátý';
	    if (($formlen >= $lemlen)&&($lemlen>2)) {
		my ($sufx_start,$sufx_len) = ($lemlen-1, $formlen-$lemlen+1);
		my $sufx = substr($nform,$sufx_start,$sufx_len);
		if ($formcap) { $nform = 'Pát'; }
		else { $nform = 'pát'; }
		$nform .= $sufx;
	    }
	}
	elsif ($nlem =~ /jeden$/) {
	    $nlem = 'jeden';
	    if (($formlen >= $lemlen)&&($lemlen>4)) {
		my ($sufx_start,$sufx_len) = ($lemlen-4, $formlen-$lemlen+4);
		my $sufx = substr($nform,$sufx_start,$sufx_len);
		if ($formcap) { $nform = 'J'; }
		else { $nform = 'j'; }
		$nform .= $sufx;
	    }
	}
    }
    elsif ($ntag =~ /^Cz/) {
	$nfeat = 'a';
    }
    elsif ($ntag =~ /^Cy/) { $nfeat = 'y';
	if (($nlem =~ /^(šest)|(sedm)|(osm)|(devít)|((jede)|(dva)|(tři)|(čtr)|(pat)|(šest)|(sedm)|(osm)|(devate)náct)ina$/)||
	($nlem =~ /^((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set))?((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))tina$/)) {
	    my $lemlen = length($nlem);
	    my $sufx = substr($nform,$lemlen-3);
	    $nlem = 'šestina';
	    $nform = 'šest' . $sufx;
	}
	elsif (($nlem =~ /^((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))tina$/)||
	($nlem =~ /^((set)|(tisíc)|(desetitisíc)|(stotisíc))ina$/)) {
	    my $lemlen = length($nlem);
	    my $sufx = substr($nform,$lemlen-3);
	    $nlem = 'dvacetina';
	    $nform = 'dvacet' . $sufx;
	}
    }
    elsif ($ntag =~ /^Ch/) { $nfeat = 'p'; }
    elsif ($ntag =~ /^C[dk]/) {
	$nfeat = 'a';
	$nlem =~ s/^(šest)|(sedm)|(osm)|(devat)|(desat)|((jede)|(dva)|(tři)|(čtr)|(pat)|(šest)|(sedm)|(osm)|(devate)náct)erý$/paterý/;
	$nform =~ s/^[A-ZŠČ].+er(.+)/Pater$1/; $nform =~ s/^[^A-ZŠČ].+er(.+)/pater$1/;
    }
    else { $nfeat = '???'; }

    return ($nform,$nlem,$nfeat);
}

sub simplify_adv_forms_and_lemmas {
    my ($aform,$alem) = @_;
    my $atype = '';
    my $formcap = 0;
    if ($aform =~ /^[A-ZČĎŇŘŠŤŽ].+/) { $formcap = 1; }

    if (defined $ADV_TYPE{$alem}) {
	$atype = $ADV_TYPE{$alem};
	if ($atype eq 'n') {
	    if ($formcap) { $aform = 'Česky'; }
	    else { $aform = 'česky'; }
	    $alem = 'česky';
	}
	elsif ($atype eq 'clr') {
	    if ($formcap) { $aform = 'Černě'; }
	    else { $aform = 'černě'; }
	    $alem = 'černě';
	}
    }
    elsif ($alem =~ /^napo((prvé)|(druhé)|(třetí)|(čtvrté)|(páté)|(šesté)|(sedmé)|(osmé)|(deváté)|(desáté)|(.+nácté)|(.+cáté)|(.+desáté))$/) {
	if ($formcap) { $aform = 'Napoxté'; }
	else { $aform = 'napoxté'; }
	$alem = 'napoxté';
    }
    elsif ($alem =~ /.+násobně$/) {
    	if ($formcap) { $aform = 'Xnásobně'; }
	else { $aform = 'xnásobně'; }
	$alem = 'xnásobně';
    }
    elsif ($alem =~ /((kde)|(kam)|(kudy)|(odkud)|(kdy)|(jak)|(kolik))/) {
	if ($alem =~ /.+kolik$/) {
	    $alem = 'několik'; if ($formcap) { $aform = 'Několik'; } else { $aform = 'několik'; }
	}
	elsif ($alem =~ /^((kde)|(kam)|(kudy)|(odkud)|(kdy)|(jak))koliv?$/) {
	    $alem =~ s/^(.+)koliv?$/$1si/;
	    $aform =~ s/^(.+)koliv?$/$1si/;
	}
	elsif ($alem =~ /^((lec)|(leda)|(ledas)|(kde)|(sotva)|(málo)|(zřídka)|(bůhví)|(čertví))((kde)|(kam)|(kudy)|(odkud)|(kdy)|(jak))$/) {
	    $alem =~ s/((lec)|(ledas)|(leda)|(kde)|(sotva)|(málo)|(zřídka)|(bůhví)|(čertví))(.+)$/$+si/;
	    my $ucform = $aform;
	    $aform =~ s/(([Ll]ec)|([Ll]edas)|([Ll]eda)|([Kk]de)|([Ss]otva)|([Mm]álo)|([Zz]řídka)|([Bb]ůhví)|([Čč]ertví))(.+)$/$+si/;
	    if ($ucform =~ /^[A-ZČ].+/) { $aform = uc(substr($aform,0,1)) . substr($aform,1); }
	}
    }

    return ($aform, $alem);
}

sub simplify_verbs_forms_and_lemmas {
    my ($vform,$vlem,$vtag) = @_;
    my $formcap = 0;
    my $newlem = $VERBS_simp{$vlem};
    my ($lemlen,$formlen) = (length($vlem),length($vform));
    my $sufx_type = 'at';
    if ($vlem =~ /ovat$/) { $sufx_type = 'ovat'; }
    elsif ($vlem =~ /it$/) { $sufx_type = 'it'; }

    my $sufx;
    if (($sufx_type eq 'at')||($sufx_type eq 'it')) {
	if (($sufx_type eq 'it')&&($vtag =~ /^Vi/)) {
	    if ($vtag =~ /^Vi.S/) { $sufx = '';}
	    elsif ($vtag =~ /^Vi.P...1/) { $sufx = 'me';}
	    else { $sufx = 'te'; }
	}
	elsif ($formlen < $lemlen-2) {
	    return ($vform, $newlem); }
	else {
	    $sufx = lc(substr($vform,$lemlen-2)); }
    }
    else { $sufx = lc(substr($vform,$lemlen-4)); }

    my $newlng = length($newlem);
    my $newform;

    if ($newlem eq 'obrat') { $newform = $vform; }
    elsif ($newlem eq 'záležet') {
	$newform = substr($vform,0,1) . 'álež' . substr($vform,5);
    }
    elsif ($vform =~ /^[A-ZČĎŇŘŠÚŤŽ].+/) {
	if (($sufx_type eq 'at')||($sufx_type eq 'it')) { $newform = uc(substr($newlem,0,1)) . substr($newlem,1,$newlng-3) . $sufx; }
	elsif ($sufx_type eq 'ovat') { $newform = uc(substr($newlem,0,1)) . substr($newlem,1,$newlng-5) . $sufx; }
    }
    else {
	if (($sufx_type eq 'at')||($sufx_type eq 'it')) { $newform = substr($newlem,0,$newlng-2) . $sufx; }
	elsif ($sufx_type eq 'ovat') { $newform = substr($newlem,0,$newlng-4) . $sufx; }
    }

    if ((defined $newform) && ($newform =~ /^(([Ss]pust)|([Šš]íř)|([Uu]sad))((me)|(te))?$/)) {
	$newform =~ s/^([Ss])pust/$1pusť/; $newform =~ s/^([Šš])íř/$1iř/; $newform =~ s/^([Uu])sad/$1saď/; }
    if (not defined $newform) { ($newlem,$newform)=($vlem,$vform); }

    return ($newform,$newlem);
}

sub unify_formal_variants_of_verbs {
    my ($vform, $vlem, $vtag) = @_;
    my $vflen = length($vform);
    if ($vtag =~ /^Vf/) {
	if (($vform =~ /ct$/)&& ($vlem =~ /ci$/)) { $vform = substr($vform,0,$vflen-1) . 'i'; }
	elsif (($vform =~ /ti$/)&& ($vlem =~ /t$/)) { $vform = substr($vform,0,$vflen-1); }
    }
    elsif (($vtag =~ /^VB\-S\-\-\-1/)||($vtag =~ /^VB\-P\-\-\-3/)) {
	if (($vlem =~ /[szk][aá]t$/)&&($vform =~ /[šžč][ií]$/)) { # píši, pláči, táži
	    if ($vform =~ /i$/) { $vform = substr($vform,0,$vflen-1) . 'u'; }
	    else { $vform = substr($vform,0,$vflen-1) . 'ou'; }
	}
	elsif (($vlem =~ /((ova)|(ou)|[ýíá])t$/)&&($vform =~ /jo?u$/)) { # pracujou, kryju, bijou, obuju
	    if ($vform =~ /ju$/) { $vform = substr($vform,0,$vflen-1) . 'i'; }
	    else { $vform = substr($vform,0,$vflen-2) . 'í'; }
	}
    }
    return ($vform);
}

sub simplify_vocalised_prepositions {
    my ($pr_form, $pr_lem) = @_;
    if ($pr_form =~ /^[A-ZČĎŇŘŠŤŽ]/) {
	$pr_form = uc(substr($pr_lem,0,1));
	if (length($pr_lem)>1) { $pr_form .= substr($pr_lem,1); }
    }
    else { $pr_form = $pr_lem; }
    return $pr_form;
}

sub check_numgen_variables {
    my ($tg,$lm,$fo) = @_;
    my $ng = substr($tg,2,2);
    my $ps = substr($tg,0,2);
    if (($ng =~ /(NP)|(FS)/) && ($ps =~ /^(Vs..[^4])|(Vp)|(AC)/)) {	$ng = 'QW'; }
    elsif ($tg =~ /^(Vs)|(Vp)|(AC)[IF]P/) {				$ng = 'TP'; }
    elsif ($tg =~ /^Cl[FN]P[14]/) {					$ng = 'HP'; }
    elsif (($tg =~ /^PS[FN]P[15]/) && (lc($fo) !~ /^(mé)|(tvé)$/)) {	$ng = 'HP'; }
    elsif (($tg =~ /^PS[FN]S[15]/) && (lc($fo) !~ /^(má)|(tvá)$/)) {	$ng = 'HS'; }
    elsif ($tg =~ /^V[em][FN]S/) {					$ng = 'HS'; }
    elsif (($tg =~ /^PP[MIN]S[1-7]\-\-3/)&&(lc($fo) =~ /^(jemu)|(jej)|(jím)$/)) { $ng = 'ZS'; }
    elsif ($tg =~ /^PP[MI]S[1-7]\-\-3/) {				$ng = 'YS'; }
    elsif ($tg =~ /^(A[CO][MI]S1)|(Vs[MI]S[^4])|(V[emp][MI]S)/) {	$ng = 'YS'; }
    elsif ($tg =~ /^(C[lw][MI])|(P[48DJLPSWZ][MI])S1/) {		$ng = 'YS'; }
    elsif ($tg =~ /^(Cd[MI]S7)|(PS[MI]S5)/) {				$ng = 'YS'; }
    elsif (($tg =~ /^PL[MI]S4/) && (lc($fo) eq 'všechen')) {		$ng = 'YS'; }
    elsif ($tg =~ /^V[em][FMIN]P/) {					$ng = 'XP'; }
    elsif ($tg =~ /^(C[dhl])|(P[14589DJLPSWZ])[MIFN]P[2367]/) {		$ng = 'XP'; }

    return $ng;
}

sub simplify_quantified_words {
    my ($lm,$fo,$tg) = @_;
    my $qpos = substr($tg,0,1);
    my $qtype = 0;
    my $ltype = '';
    my $lm0 = lc($lm);
    my $q0 = lc($lm);
    my ($newlm, $newfo, $sfxln) = ('','',1);

#    print "$fo $lm\t";

    if (($q0 !~ /^(((tisíc)?((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set)))?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)((jedna)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))).+/)&&
    ($q0 !~ /^(((tisíc)?((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set)))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)).+/)&&
    ($q0 =~ s/^(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti).+/$1/)) {
	$lm0 =~ s/^(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)//;
	$qtype = '5'; }
    elsif ($q0 =~ s/^(((tisíc)?((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set)))?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)((jedna)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))).+/$1/) {
	$lm0 =~ s/^((tisíc)?((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set)))?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)((jedna)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))//;
	$qtype = '7'; }
    elsif ($q0 =~ s/^(((tisíc)?((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set)))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)).+/$1/) {
	$lm0 =~ s/^(((tisíc)?((sto)|(dvěstě)|(třista)|(čtyřista)|(((pět)|(šest)|(sedm)|(osm)|(devět))set)))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti))//;
	$qtype = '7'; }
    elsif ($q0 =~ s/^(((sto)|(dvouset)|(tříset)|(čtyřset))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti)).+/$1/) {
	$lm0 =~ s/^(((sto)|(dvouset)|(tříset)|(čtyřset))?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))ti))//;
	$qtype = '8'; }
    elsif ($q0 =~ s/^((jedno)|(dvou)|(tří)|(čtyř)).+/$1/) {
	$lm0 =~ s/^((jedno)|(dvou)|(tří)|(čtyř))//;
	$qtype = '1'; }
    elsif ($q0 =~ s/^((pěti)|(šesti)|(sedmi)|(osmi)|(devíti)).+/$1/) {
	$lm0 =~ s/^((pěti)|(šesti)|(sedmi)|(osmi)|(devíti))//;
	$qtype = '2'; }
    elsif ($q0 =~ s/^(((jede)|(dva)|(tři)|(čtr)|(pat)|(šest)|(sedm)|(osm)|(devate))nácti).+/$1/) {
	$lm0 =~ s/^(((jede)|(dva)|(tři)|(čtr)|(pat)|(šest)|(sedm)|(osm)|(devate))nácti)//;
	$qtype = '4'; }
    elsif ($q0 =~ s/^((sto)|(tisíci)).+/$1/) {
	$lm0 =~ s/^((sto)|(tisíci))//;
	$qtype = '6'; }
    elsif ($q0 =~ s/^((dvoj)|(troj))./$1/) {
	$lm0 =~ s/^((dvoj)|(troj))//;
	$qtype = '3'; }
    elsif ($q0 =~ s/^([1-9][0-9]*)[^0-9]+/$1/) {
	$lm0 =~ s/^([1-9][0-9]*)//;
	$qtype = '9'; }
    elsif ($q0 =~ s/^(několika).+/$1/) {
	$lm0 =~ s/^(několika)//;
	$qtype = '10'; }
    elsif ($q0 =~ s/^((mnoho)|(mnoha)|(více)).+/$1/) {
	$lm0 =~ s/^((mnoho)|(mnoha)|(více))//;
	$qtype = '11'; }
    elsif ($q0 =~ s/^((sto)?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvacá)|(třicá)|(čtyřicá)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))t))[^i].+/$1/) {
	$lm0 =~ s/^((sto)?(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?(((dvacá)|(třicá)|(čtyřicá)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))t))//;
	$qtype = '5.5'; }

    if ($qtype == 0) {
	return ($lm,$fo); }

    if ($qpos eq 'N') {
	if (($lm0 eq 'dolar')&&($qtype =~ /^[1-6]$/)) { $newlm = 'dolar'; $sfxln = 0; }
	elsif (($lm0 =~ /^(stěn)|(úhelník)$/)&&($qtype =~ /^([1-7])|(1[10])$/)) { $newlm = 'úhelník'; $sfxln = 0; }
	elsif (($lm0 =~ /^hal[éí]ř$/)&&($qtype =~ /^[1-6]$/)) { $newlm = 'haléř'; $sfxln = 0; }
	elsif (($lm0 eq 'euro')&&($qtype =~ /^[1-6]$/)) { $newlm = 'euro'; }
	elsif (($lm0 =~ /^(minutovka)|(hodinovka)|(vteřinovka)$/)&&($qtype =~ /^[1-7]$/)) { $newlm = 'minutovka'; }
	elsif (($tg =~ /^NNM/)&&($lm0 eq 'ník')&&($qtype eq '5.5')) { $newlm = 'cátník'; }

	if (($newlm eq '')&&($qtype =~ /^[1-6]$/)) {
	    foreach my $nqt (qw(koruna kačka librovka dolarovka eurovka markovka rublovka)) {
		if ($nqt eq $lm0) { $newlm = 'koruna'; last; } }
	}
    }
    elsif ($qpos eq 'A') {
	if ($lm0 =~ /^((sekundový)|(vteřinový)|(minutový))$/) { $newlm = 'sekundový'; }
	elsif ($lm0 eq 'hodinový') { $newlm = $lm0; }
	elsif ($lm0 =~ /^(denní)|(týdenní)|(měsíční)$/) { $newlm = 'denní'; }
	elsif ($lm0 =~ /^(letý)|(násobný)|(procentní)|(členný)|(dílný)|(pruhový)|(hvězdičkový)|(místný)|(ciferný)|(litrový)|(paprskový)|(kanálový)|(gólový)|(kusový)$/) {
	    $newlm = $lm0; }
	elsif ($lm0 =~ /^(((kilo)||(deka)|(mili)|(centi)|(mikro)|(nano))?gramový)|(((kilo)|(mega))?tunový)|(kilový)$/) {
	    $newlm = 'gramový'; }
	elsif ($lm0 =~ /^(((kilo)|(mili)|(deci)|(centi)|(mikro)|(nano))?metrový)|(palcový)|(mílový)$/) { $newlm = 'metrový'; }
	elsif ($lm0 =~ /^(poschoďový)|(patrový)$/) { $newlm = 'patrový'; }
	elsif ($lm0 eq 'tisícový') { $newlm = $lm0; }
	elsif ($lm0 =~ /^(milionový)|(miliónový)|(miliardový)$/) { $newlm = 'milionový'; }
	elsif ($lm0 =~ /^(hektarový)|(akrový)$/) { $newlm = 'hektarový'; }
	elsif ($lm0 =~ /^(bodový)|(stupňový)|(stránkový)|(wattový)|(megawattový)|(místný)|(kilotunový)|(akrový)|(hlavý)|(gólový)|(svazkový)|(palcový)$/) {
	    $newlm = $lm0; }
	elsif ($lm0 =~ /^(dolarový)|(korunový)|(librový)|(eurový)|(markový)|(frankový)|(rublový)|(centový)|(haléřový)|(halířový)$/) {
	    $newlm = 'korunový'; }
    }
    elsif ($qpos eq 'D') {
	if ($lm0 =~ /^((procentně)|(násobně)|(bodově))$/) { $newlm = $lm0; }
    }

    if ($newlm eq '') {
	return ($lm,$fo); } # ESCAPE

    my ($flen,$llen,$nllen) = (length($fo),length($lm),length($newlm));
    if ($flen >= $llen-1) {
	if (($sfxln == 1) && ($llen == $flen) && ($newlm =~ /.+[ao]$/) && # (gen. pl. u feminin a neuter, "pětikaček"
	(substr($lm,$llen-2,1) eq substr($fo,$flen-1,1)) && (substr($fo,$flen-2,1) eq 'e')) {
	    if (substr($newlm,$nllen-3,1)=~/^[aáeéěiíoóuůyý]$/) {
		$newfo = substr($newlm,0,$nllen-1); }
	    else { $newfo = substr($newlm,0,$nllen-2) . 'e' . substr($newlm,$nllen-2,1); }
	}
	elsif (($llen == $flen+1)&&($newlm =~ /.+[ao]$/)&&($fo !~ /[aáeéěiíoóuůyý]$/)) {
	    if (substr($newlm,$nllen-3,1)=~/^[aáeéěiíoóuůyý]$/) {
		$newfo = substr($newlm,0,$nllen-1); }
	    else { $newfo = substr($newlm,0,$nllen-2) . 'e' . substr($newlm,$nllen-2,1); }
	}
	elsif ($flen >= $llen) {
	    my $sfx = lc(substr($fo,$llen-$sfxln));
	    $newfo = substr($newlm,0,$nllen-$sfxln) . $sfx;
	}
	else { $newfo = $fo; }
    }
    if ($fo =~ /^[A-ZČĎŇŘŠŤŽÁÉÍÓÚÝ]/) { $newfo = 'X' . $newfo; }
    else { $newfo = 'x' .  $newfo; }
    $newlm = 'x'. $newlm;
    return ($newlm, $newfo);
}

sub lc_first_word {
    my ($fo,$le) = @_;
    if (substr($le,0,1) eq lc(substr($le,0,1))) {
	$fo = lc($fo);
    }
    return $fo;
}

sub correction_filter {
    my ($fo,$lm,$tg,$xx) = @_;

    if (($fo =~ /[Vv]lastně/)&&($tg =~ /^Ve/)) {
	$lm = 'vlastně';
	if ($tg =~ /^.{16}/) { $tg = 'Db--------------'; }
	else { $tg = 'Db-------------'; }
    }
    elsif (($fo =~ /[Nn]espočet/)&&($tg =~ /^Vm/)) {
	$lm = 'nespočet';
	if ($tg =~ /^.{16}/) { $tg = 'NNIS4-----A-----'; }
	else { $tg = 'NNIS4-----A----'; }
    }
    elsif (($fo =~ /^((([Jj]eden)|([Dd]va)|([Tt]ři)|([Čč]tyři)|([Pp]ět)|([Šš]est)|([Ss]edm)|([Oo]sm)|([Dd]evět))a)?(([Dd]vace)|([Tt]řice)|([Čč]tyřice)|([Pp]adesá)|([Šš]edesá)|([Ss]edmdesá)|([Oo]smdesá)|([Dd]evadesá))tin.*$/)&&
    ($tg =~ /^Cy.P.*/) &&
    ($lm =~ /^(((jeden)|(dva)|(tři)|(čtyři)|(pět)|(šest)|(sedm)|(osm)|(devět))a)?((dvace)|(třice)|(čtyřice)|(padesá)|(šedesá)|(sedmdesá)|(osmdesá)|(devadesá))tina$/) &&
    (($xx == 1) || ($z_tags[$xx-1] !~ /^C/))) {
	my $lemlen = length($lm);
	$lm = substr($lm,0,$lemlen-1) . 'y';
	if (length($tg) == 15) { $tg = 'NNFP' . substr($tg,4,1) . '-----A----'; }
	else { $tg = 'NNFP' . substr($tg,4,1) . '-----A-----'; }
    }
    return ($fo,$lm,$tg);
}

sub cut_lemmas_tail { # Odstraní "ocas" lemmatu, tj. "-2", "_(komentář)", "`jiný komentář"
    my ($cutlemma) = @_;
    $cutlemma =~ s/([^\_\`\-]+)[\_\`\-].+/$1/;
    return $cutlemma;
}

sub open_output_files {
    my ($inp_file) = @_;
    if ($single_output ne '') {
	$inp_file = $single_output . '.vert';
    }
    if ($in_format eq 'N') {
	my $OUTFILE_BACK = $inp_file . 'backup';
	open $OU_BACK, '>:utf8', $OUTFILE_BACK or die "Nemohu otevřít soubor $OUTFILE_BACK!\n";
    }
    if ($out_format eq 'M') {
	my $OUTF_CONLL = $inp_file;
	$OUTF_CONLL =~ s/vert$/conll/;
	open $OU_CONLL, '>:utf8', $OUTF_CONLL or die "Nemohu otevřít soubor $OUTF_CONLL!\n";
    }
    elsif ($out_format =~ /^C[2345]?/) {
	my $OUTF_MCD = $inp_file;
	$OUTF_MCD =~ s/vert$/mcd/;
	open $OU_MCD, '>:utf8', $OUTF_MCD or die "Nemohu otevřít soubor $OUTF_MCD!\n";
    }
}

sub close_output_files {
    if ($out_format eq 'M') { close $OU_CONLL; }
    elsif ($out_format =~ /^C[2345]?/) { close $OU_MCD; }
    if ($in_format eq 'N') { close $OU_BACK; }
}

sub empty_sentence_arrays {
    $#z_forms=-1; $#z_lemmas=-1; $#z_tags=-1; $#z_afuns=-1; $#z_heads=-1; $#z_heads=-1; $#z_features=-1;
    $#new_forms=-1; $#new_lemmas=-1; $#new_tags=-1; $#new_afuns=-1; $#new_heads=-1; $#synt_features=-1;
    $#ch_forms=-1; $#ch_lemmas=-1; $#ch_ords=-1; 
    if ($additional_in_vert) { @additional=(); }
    if ($allow_chunking) { $#recover_chunking=-1; }
}

sub print_sentence {
    my ($form_line,$tag_line,$afun_line,$head_line) = ('','','','');
#    print "TEST RECOVER:\n";
#    foreach my $test_rec (1..$#z_forms) {
#	print "\t$test_rec $z_forms[$test_rec] ";
#	if (defined $recover_chunking[$test_rec]) {
#	    print "\"$recover_chunking[$test_rec]\""; }
#    }
#    print "\n";

    if ($in_format eq 'T') {
#	print "HEADS";
	foreach my $yy (1 .. $#z_forms) {
#	    if ($allow_chunking) {
#		my $hdx = $z_heads[$yy]; if (defined $new_heads[$yy]) { $hdx = $new_heads[$yy]; }
#		my $chhdx = $hdx; if (defined $ch_ords[$hdx]) { $chhdx = $ch_ords[$hdx]; }
#		if ($new_forms[$yy] ne '') {
#		    print "$yy\t$ch_ords[$yy]\t$new_forms[$yy]\t$hdx\t$chhdx\n"; }
#	    }
#	    print "\t$yy:\"$z_heads[$yy]\"";
	    if (not defined $new_heads[$yy]) { $new_heads[$yy]=$z_heads[$yy]; }
	    if (not defined $new_afuns[$yy]) { $new_afuns[$yy]=$z_afuns[$yy]; }
	}
#	print "\n";
#	if ($allow_chunking) { detect_cycle(); }
    }
    foreach my $y (1..$#z_forms) {
    	my ($frm, $lm, $tg, $ps, $ftr) = ($new_forms[$y], $new_lemmas[$y], $new_tags[$y], substr($new_tags[$y],0,1), $z_features[$y]);
	my $hd; if ($in_format eq 'T') { $hd = $new_heads[$y]; }

	next if (($allow_chunking)&&(not defined $z_forms[$y]));

	if (($in_format eq 'T')&&($allow_chunking)&&(defined $ch_ords[$hd])) {
	    $hd = $ch_ords[$hd];
	}
    	if ($lc_first_form && ($y == 1) && ($frm =~ /^[A-ZÁÉĚÍÓÚÝČĎŇŘŠŤŽ]/)) {
    	    $frm = lc_first_word($frm,$lm); }
	if (($out_format eq 'M')&&(($frm ne "")||($allow_chunking==0))) {
	    if ($allow_chunking) { printf $OU_CONLL "%d	%s	%s	%s	%s	%s", $ch_ords[$y], $frm, $lm, $ps, $ps, $ftr; }
	    else { printf $OU_CONLL "%d	%s	%s	%s	%s	%s", $y, $frm, $lm, $ps, $ps, $ftr; }

#	    if ($in_format eq 'T') { printf $OU_CONLL "	%d	%s	%d	%s\n", $hd, $new_afuns[$y], $hd, $new_afuns[$y]; }
	    if ($in_format eq 'T') { printf $OU_CONLL "	%d	%s	_	_\n", $hd, $new_afuns[$y]; }
	    else { print $OU_CONLL "	_	_	_	_\n"; }
	}
	if ($in_format eq 'N') {
	    if (($frm eq "")&&($allow_chunking==1)) {
		printf $OU_BACK "\"REMOVED\"	\"REMOVED\"	%s	%s	%s", $z_forms[$y], $z_lemmas[$y], $z_tags[$y]; }
	    else {
		printf $OU_BACK "%s	%s	%s	%s	%s", $frm, $lm, $z_forms[$y], $z_lemmas[$y], $z_tags[$y]; }

	    if (($allow_chunking==1)&&(defined $recover_chunking[$y])&&($recover_chunking[$y] ne '')) {
		if ($recover_chunking[$y] eq 'R') { print $OU_BACK "\tCHUNKING:REG"; }
		elsif ($recover_chunking[$y] =~ /.+:.+/) { print $OU_BACK "\t$recover_chunking[$y]"; }
	    }
	    elsif ($additional_in_vert) { print $OU_BACK "\t"; }
	    if ($additional_in_vert) { print $OU_BACK "\tAD:$additional[$y]"; }
	    print $OU_BACK "\n";
	}
	if ($out_format =~ /^C[2345]?$/) {
	    next if (($frm eq "")&&($allow_chunking==1));
	    if ($mcd_lemmas == 0) { $form_line .= "\t" . $frm; }
	    else { $form_line .= "\t" . $lm; }
	    $tag_line .= "\t" . reduce_tag_for_mcd($tg,$y);
	    if ($in_format eq 'N') { $afun_line .= "\t" . 'ExD'; $head_line .= "\t" . '0'; }
	    else { $afun_line .= "\t" . $new_afuns[$y]; $head_line .= "\t" . $hd; }
	}
    }
    if ($out_format =~ /^C[2345]?$/) {
	$form_line =~ s/^\t(.+)/$1/; $tag_line =~ s/^\t(.+)/$1/;
	$afun_line =~ s/^\t(.+)/$1/; $head_line =~ s/^\t(.+)/$1/;
	print $OU_MCD "$form_line\n$tag_line\n$afun_line\n$head_line\n\n";
    }
    else { print $OU_CONLL "\n"; }

    if ($in_format eq 'N') { print $OU_BACK "\n"; }
}

sub unify_coap_suffixes { # Sjednotí koncovky _Co a _Ap, vrácení původních hodnot pak záleží na řídícím členu.
    my ($coap_afun) = @_;
    $coap_afun =~ s/\_((Co)|(Ap))$/_CA/;
    return $coap_afun;
}

sub remove_combined_afuns { # Odstraní kombinované funkce typu AdjAtr, nahradí je jednoduchou funkcí (pro jistotu ověřuje, na čem visí)
    my ($comb) = @_;
    my ($c_af,$c_head) = ($z_afuns[$comb], $z_heads[$comb]);
    my $head_pos = '';
    my $coo_ap = 0;
    if ($c_af =~ /.+\_(Co)|(Ap)$/) { $coo_ap = 1; }
    if ($c_head > 0) {
	if (($z_afuns[$c_head] =~ /^Aux[PC]$/)&&(defined ($z_heads[$c_head])) && ($z_heads[$c_head]>0)) {
	    $c_head = $z_heads[$c_head]; }
	if ($z_afuns[$c_head] =~ /^(Coord)|(Apos)/) {
	    if ($coo_ap == 1) {
		while ((defined $z_heads[$c_head])&&($z_heads[$c_head]>0)&&
		($z_afuns[$c_head] =~ /^(Coord)|(Apos)|(AuxP)|(AuxC)/)) {
		    $c_head = $z_heads[$c_head]; }
		$head_pos = substr($z_tags[$c_head],0,1);
	    }
	    else {
		foreach my $xx (1 .. $#z_forms) {
		    if (($z_heads[$xx] == $c_head)&&($xx != $comb)&&
		    ($z_afuns[$xx] =~ /(AuxP)|(AuxC)|(_Co)|(_Ap)$/)) {
			if ($z_afuns[$xx] =~ /(AuxP)|(AuxC)$/) {
			    my $jumpout = 0;
			    foreach my $yy (1 .. $#z_forms) {
				if (($z_heads[$yy] == $xx)&&($z_afuns[$yy] =~ /(_Co)|(_Ap)$/)) {
				    $jumpout = 1;
				    $head_pos = substr($z_tags[$yy],0,1);
				    last;
				}
			    }
			    if ($jumpout == 1) { last; }
			}
			else {
			    $head_pos = substr($z_tags[$xx],0,1);
			    last;
			}
		    }
		}
	    }
	}
	else {
	    $head_pos = substr($z_tags[$c_head],0,1); }
    }

    my $new_af = $c_af;
    $new_af =~ s/^((Atr)|(Obj)|(Adv))((Atr)|(Obj)|(Adv))((_Co)|(_Ap))?$/$1/;

    if (($head_pos eq 'N') && ($c_af =~ /Atr/)) {
	$new_af = 'Atr'; }
    elsif (($head_pos =~ /^[VAD]$/) && ($c_af =~ /Obj/)) {
	$new_af = 'Obj'; }
    elsif (($head_pos =~ /^[VAD]$/) && ($c_af =~ /Adv/)) {
	$new_af = 'Adv'; }
    if ($coo_ap == 1) {
	my $coapsfx = '';
	if ($c_af =~ /_Ap$/) { $coapsfx = '_Ap'; }
	else { $coapsfx = '_Co'; }

	$new_af .= $coapsfx;
    }
    return $new_af;
}

sub modify_subord_verbs_afun {
    my ($fv) = @_;
    my $mod_verb_afun = $z_afuns[$fv];
#    my $isfinv = is_finite_verb($fv);
#    print "$fv $z_forms[$fv] $isfinv\n";
    if ((is_finite_verb($fv))&&($z_afuns[$fv] =~ /^((Sb)|(Obj)|(Adv)|(Atr))(_(Co)|(Ap))?$/)) {
	$mod_verb_afun = 'Pred_' . $mod_verb_afun; }
    return $mod_verb_afun;
}

sub is_finite_verb {
    my ($fv) = @_;
    my $is_fv = 0;
    if (($z_afuns[$fv] eq 'AuxV')||($z_afuns[$fv] eq 'AuxV_Co')) {
	$is_fv = 0; }
    elsif ($z_tags[$fv] =~ /^V[Bip]/) {
	$is_fv = 1; }
    elsif ($z_tags[$fv] =~ /^Vs/) {
	foreach my $axv (1 .. $#z_forms) {
	    if (($axv != $fv)&&($z_heads[$axv]==$fv)) {
		if (($z_afuns[$axv] eq 'AuxV')&&($z_lemmas[$axv] =~ /^bý(va)?t$/)) {
		    $is_fv = 1; last;
		}
		elsif ($z_afuns[$axv] eq 'Coord') {
		    foreach my $bxv (1 .. $#z_forms) {
			if (($bxv != $fv)&&($z_heads[$bxv]==$axv)&&
			($z_afuns[$bxv] eq 'AuxV_Co')&&($z_lemmas[$bxv] =~ /^bý(va)?t$/)) {
			    $is_fv = 1; last; }
		    }
		    if ($is_fv == 1) { last; }
		}
	    }
	}
    }
    elsif ($z_tags[$fv] =~ /^Vf/) {
	foreach my $axv (1 .. $#z_forms) {
	    if (($axv != $fv)&&($z_heads[$axv]==$fv)) {
		if (($z_afuns[$axv] eq 'AuxV')&&($z_lemmas[$axv] eq 'být')&&($z_tags[$axv] =~ /^VB......F/)) {
		    $is_fv = 1; last;
		}
		elsif ($z_afuns[$axv] eq 'Coord') {
		    foreach my $bxv (1 .. $#z_forms) {
			if (($bxv != $fv)&&($z_heads[$bxv]==$axv)&&
			($z_afuns[$bxv] eq 'AuxV_Co')&&($z_lemmas[$bxv] eq 'být')&&($z_tags[$bxv] =~ /^VB......F/)) {
			    $is_fv = 1; last; }
		    }
		    if ($is_fv == 1) { last; }
		}
	    }
	}
    }
    return $is_fv;
}

sub reduce_tag_for_mcd {
    my ($tag_2_red,$zz) = @_;
    my $reduce = 2;
    if ($out_format =~ /^C[345]$/) { $reduce = $out_format; $reduce =~ s/^C([345])$/$1/; }
    my $tag_reduced = substr($tag_2_red,0,1);
    my $vfor = '';
    if (($tag_2_red =~ /^V/)&&($z_features[$zz] =~ /VForm\=/)) {
	$vfor = $z_features[$zz];
	$vfor =~ s/^.*VForm\=(.).*$/$1/;
    }
    if ((($simplify_forms == 2)||($simplify_forms == 0)) && ($reduce == 2)) {
	my $case = substr($tag_2_red,4,1);
	if ($case !~ /[1234567]/) { $case = substr($tag_2_red,1,1); }
	$tag_reduced .= $case;
    }
    elsif (($reduce == 2)||($reduce == 3)) {
	my $case = substr($tag_2_red,4,1);
	if ($case !~ /[1234567]/) { $case = substr($tag_2_red,1,1); }
	if (($reduce == 3)&&($vfor ne '')) {
	    $tag_reduced .= $vfor;
	    $case = substr($tag_2_red,9,1); 
	    if ($case eq '1') { $case = 'a'; }
	    elsif ($case eq '2') { $case = 'b'; }
	    else { $case = 'c'; }
	}
	elsif ($reduce == 3) { $tag_reduced .= $synt_features[$zz]; }
	$tag_reduced .= $case;
    }
    elsif ($reduce > 3) {
	my $pos = substr($tag_2_red,0,1);
	my $case = substr($tag_2_red,4,1);
	my $syntsubpos = $synt_features[$zz];
	if (($tag_2_red =~ /^V/)&&($z_features[$zz] =~ /VForm\=/)) {
	    my $vfor = $z_features[$zz];
	    $vfor =~ s/^.*VForm\=(.).*$/$1/;
	    if ($vfor eq 'P') { $vfor = 'B'; }
	    elsif ($vfor eq 'p') { $vfor = 'm'; }
	    elsif ($vfor eq 'c') { $vfor = 'y'; }
	    $syntsubpos = $vfor;
	}
	my $numgen = substr($tag_2_red,2,2);
	if ($reduce == 4) {
	    $numgen =~ s/^[MIY]S/m/; $numgen =~ s/^[MIY][PD]/M/;
	    $numgen =~ s/^FS/f/; $numgen =~ s/^F[PD]/F/; $numgen =~ s/^QW/f/;
	    $numgen =~ s/^NS/n/; $numgen =~ s/^N[PD]/N/;
	    $numgen =~ s/^[^MINFY]S/S/; $numgen =~ s/^[^MINFY][PD]/P/;
	    $numgen =~ s/^..$/x/;
	}
	if ($case !~ /[1234567]/) {
	    if ($tag_2_red =~ /^V.{7}[123]/) {
		$case = substr($tag_2_red,7,1);
		if ($case eq '1') { $case = 'a'; }
		elsif ($case eq '2') { $case = 'b'; }
		else { $case = 'c'; }
	    }
	    elsif ($tag_2_red =~ /^D.{9}[23]/) {
		$case = substr($tag_2_red,9,1); 
		if ($case eq '2') { $case = 'Y'; }
		else { $case = 'Z'; }
	    }
	}
	$tag_reduced = $pos . $syntsubpos . $numgen . $case;
    }
    return $tag_reduced;
}
sub create_zeman_like_conll_features {
    my ($tg) = @_;
    my (@feat_names) = qw(POS SubPOS Gen Num Cas PGen PNu Per Ten Gr Neg Voi - - Var);
    my (@tag_parts) = split //, $tg;
    my $zem_features = 'SubPOS=' . $tag_parts[1];
    foreach my $ix (2 .. 15) {
	if ((defined $tag_parts[$ix])&&($tag_parts[$ix] ne '-')&&($ix != 13)&&($ix != 14)) {
	    $zem_features .= '|' . $feat_names[$ix] . '=' . $tag_parts[$ix];
	}
    }
    return ($zem_features);
}

sub check_chunking { # ověří, zda tokeny nejsou součástí víceslovných konstrukcí, které zpracováváme, a případně provede změnu.
    my ($ch0) = (@_);
    my ($cf,$cl) = ($z_forms[$ch0],$z_lemmas[$ch0]);
    my $upper=0;
    foreach my $chc (2..4) { # délka chunků; lze navýšit
	next if ((not defined $CHUNKING_first{$cf}{$chc})&&(not defined $CHUNKING_first{$cl}{$chc})&&
	((not defined $CHUNKING_first{lc($cf)}{$chc})||($ch0>1)));
	next if ($#z_forms<$ch0+$chc-1);
	if ((not defined $CHUNKING_first{$cf}{$chc})&&(defined $CHUNKING_first{lc($cf)}{$chc})&&($ch0==1)) {
	    $cf = lc($cf); $upper=1; }
	my @chkeys = ("F:$cf","L:$cl");
	foreach my $cx ($ch0+1 .. $ch0+$chc-1) {
	    my @newkeys;
	    foreach my $chk (@chkeys) { push(@newkeys,("$chk|F:$z_forms[$cx]","$chk|L:$z_lemmas[$cx]")); }
	    @chkeys = (); @chkeys = @newkeys;
	}
	foreach my $chkey (@chkeys) {
	    if ((defined $CHUNKING{$chkey})&&($CHUNKING{$chkey} =~ /^[0-9]$/)) {
		my $rg = $CHUNKING{$chkey};
		$new_tags[$ch0] = $z_tags[$ch0+$rg];
		if ($in_format eq 'T') {
		    my $cx = $ch0+$rg;
		    my $better_head = -1;
		    if (($z_heads[$cx]==$ch0)||
		    (($rg>1)&&($z_heads[$cx]==$ch0+1))||
		    (($rg>1)&&($z_heads[$cx]>0)&&($z_heads[$z_heads[$cx]]==$ch0+1))||
		    (($rg>2)&&($z_heads[$cx]==$ch0+2))||
		    (($rg>2)&&($z_heads[$cx]>0)&&($z_heads[$z_heads[$cx]]==$ch0+2))||
		    (($rg>3)&&($z_heads[$cx]>0)&&($z_heads[$z_heads[$cx]]==$ch0+3))||
		    (($rg>3)&&($z_heads[$cx]==$ch0+3))) {
			foreach my $cy ($ch0 .. $cx-1) {
			    my $cycle=0;
			    my $cz = $cy;
			    my $iterations = 0;
			    while (($z_heads[$cz]>0)&&($iterations<100)) {
				if (($z_heads[$cz] >= $ch0)&&($z_heads[$cz]<=$cx)) {
				    $cycle=1; last; }
				elsif ($z_heads[$cz]==0) {
				    $better_head=$cy; last; }
				$cz = $z_heads[$cz];
				$iterations++;
			    }
			    if (($cycle==0)&&($better_head>-1)) {
				last; }
			}
		    }
		    if ($better_head == -1) { $new_heads[$ch0]=$z_heads[$ch0+$rg]; }
		    else { $new_heads[$ch0]=$better_head; }
		    $new_afuns[$ch0]=$z_afuns[$ch0+$rg];
		}
		my $new_frm=$chkey; $new_frm=~s/\|//g; $new_frm=~s/L\://g; $new_frm=~s/F\://g;
		my $new_lm=$new_frm;
		if ($upper) { $new_frm = uc(substr($new_frm,0,1)) . substr($new_frm,1); }
		$new_forms[$ch0]=$new_frm; $ch_forms[$ch0]=$new_frm;
		$new_lemmas[$ch0]=$new_lm; $ch_lemmas[$ch0]=$new_lm;
		foreach my $chx ($ch0+1 .. $ch0+$chc-1) {
		    remove_item_while_chunking($chx);
		}
		if ($in_format eq 'N') { prepare_chunking_recover($ch0,$chkey); }
		return 1;
	    }
	}
    }
    return 0;
}

sub remove_item_while_chunking {
    my ($rem) = @_;
    $new_forms[$rem]=""; $new_lemmas[$rem]=""; $new_tags[$rem]="";
    $ch_forms[$rem]=""; $ch_lemmas[$rem]="";
    if (defined $ch_ords[$rem-1]) {
	$ch_ords[$rem]=$ch_ords[$rem-1]; }
    else {
	undef $ch_ords[$rem]; }
    if ($rem < $#z_forms) {
	foreach my $nxt ($rem+1..$#z_forms) {
	     $ch_ords[$nxt]--;
	}
    }
}

sub prepare_chunking_recover {
    my ($xx,$key) = @_;
    my $rec_ch = $CHUNKING_recover{$key};
    my (@recover_ch) = split /\|/, $rec_ch;
    foreach my $rc (0 .. $#recover_ch) { $recover_chunking[$rc+$xx]= $recover_ch[$rc]; }
}

sub utkl_2_pdt_filter_fo {
    my ($fo) = @_;
    my ($le,$tg);
    if (defined $UTKL_2_PDT_FILTER_forms{$fo}) {
	my $lemtag = $UTKL_2_PDT_FILTER_forms{$fo};
	($le,$tg) = split /\t/, $lemtag;
    }
    return ($le, $tg);
}

sub utkl_2_pdt_filter_le {
    my ($le,$tg) = @_;
    if (defined $UTKL_2_PDT_FILTER_lemmas{$le}{substr($tg,0,2)}) {
	my $lemtag = $UTKL_2_PDT_FILTER_lemmas{$le}{substr($tg,0,2)};
	($le,$tg) = split /\t/, $lemtag;
    }
    elsif (($le =~ /^-?[0-9]+[\.\,\-\:\'\;0-9]*$/) && ($tg =~ /^C[^\=]/)) {
	$tg = 'C=-------------'; }
    elsif (($le =~ /^[IVXDLCM]+$/)&&($tg =~ /^C[^\{\}\=]/)) { #{
	$tg = 'C}-------------'; }
    return ($le, $tg);
}
sub s_to {
    my ($s) = @_;
    my $byt;
    if ($in_format eq 'T') {
	$byt = $z_heads[$s];
	if (($z_tags[$byt] !~ /^V/)||($z_lemmas[$byt] !~ /^bý(va)?t$/)) {
	    return 0; }
    }
    else {
	my ($byt0,$byt1,$left,$right) = (0,0,$s,$s);
	while (($left>1)&&($byt0==0)) {
	    $left--;
	    if ($z_tags[$left] =~ /^[ZJ]/) { last; }
	    if ($z_lemmas[$left] =~ /^bý(va)?t$/) {
		if (($z_tags[$left] =~ /^V[eipf]/)||($z_tags[$left] =~ /^VB.....3/)) {
		    $byt0 = $left;
		    last;
		}
		elsif ($z_tags[$left] =~ /^VB.....[12]/) {
		    $byt1 = $left;
		}
	    }
	}
	while (($right<$#z_forms)&&($byt0==0)) {
	    $right++;
	    if ($z_tags[$right] =~ /^[ZJ]/) { last; }
	    if ($z_lemmas[$right] =~ /^bý(va)?t$/) {
		if (($z_tags[$right] =~ /^V[eipf]/)||($z_tags[$right] =~ /^VB.....3/)) {
		    $byt0 = $right;
		    last;
		}
		elsif (($z_tags[$right] =~ /^VB.....[12]/)&&($byt1==0)) {
		    $byt1 = $right;
		}
	    }
	}
	if ($byt0) { $byt=$byt0; }
	elsif ($byt1) { $byt=$byt1; }
	else { return 0; }
    }
    $new_lemmas[$byt]='být_s_to';
    $new_forms[$byt].='_s_to';

    if ($in_format eq 'T') {
	foreach my $otherobj (1 .. $#z_forms) { # Vrátí funkci Obj tam, kde byla odmazána kvůli slovesu být
	    if (($z_heads[$otherobj]==$byt)&&($z_afuns[$otherobj] =~ /^Obj/)&&
	    (defined $new_afuns[$otherobj])&&($new_afuns[$otherobj] =~ /^Adv/)) {
		$new_afuns[$otherobj]=~s/^Adv/Obj/;
	    }
	}
    }
    if ($allow_chunking) {
	my $rel_head = $byt - $s;
	remove_item_while_chunking($s);
	remove_item_while_chunking($s+1);
	if ($in_format eq 'N') {
	    $recover_chunking[$byt]='CHUNKING:REG';
	    $recover_chunking[$s]='AuxP:' . "$rel_head";
	    $recover_chunking[$s+1]='Atr:-1';
	}
	return 2;
    }
    return 1;
}

sub remove_byt_obj {
    my ($obj) = @_;
    if (not defined $new_afuns[$obj]) {
	$new_afuns[$obj]=$z_afuns[$obj]; }
    $new_afuns[$obj]=~s/^Obj/Adv/;
}

#sub detect_cycle {
#    foreach my $i (0 .. $#z_forms) {
#	if ((defined $ch_ords[$i])&&($new_heads[$ch_ords[$i]]>0)) {
#	    if ($new_heads[$ch_ords[$i]]==$ch_ords[$i]) {
#		die "Cycle created (token head of itself) in file $FILE_err, line $., item $i (form $z_forms[$i])\n"; }
#	    my $i0 = $ch_ords[$i];
#	    my $h0 = $new_heads[$i0];
#	    my $maxit = 12;
#	    while ($h0 > 0) {
#		$i0 = $h0;
#		if (not defined $new_heads[$i]) {
#		    die "Unexpected structure in file $FILE_err, line $., item $i:\n@z_forms\n@ch_ords\n@new_heads\n"; }
#		if ($new_heads[$i0]>0) {
#		    $h0 = $ch_ords[$new_heads[$i0]];
#		    if ($h0 == $i) {
#			die "Cycle created in file $FILE_err, line $., item $i:\n@z_forms\n@ch_ords\n@new_heads\n"; }
#		}
#		else { last; }
#		print "$i0 $h0\n";
#		$maxit--;
#		if ($maxit < 0) { last; }
#	    }
#	}
#    }
#}