Laboratori de Tecnologies Lingüístiques
Institut Universitari de Lingüística Aplicada
Universitat Pompeu Fabra
Lluís de Yzaguirre i Maura

Tel 935.422.234
Fax 935.422.321

El mòdul NUMERAL.PM

package numeral;
#

use strict;
#use platform;

use vars qw(@ISA @EXPORT $VERSION);
use Exporter;
$VERSION = 1.00;
@ISA = qw(Exporter);

use vars qw($estil $genere $tipusComa $precisioDecimals);
@EXPORT = qw($estil $genere $tipusComa $precisioDecimals);

######################## procediments

push (@EXPORT, qw(cardinal roma2valor cardinal2xifra senseFonet inicialitza));

########################### DECLARACIONS

my ($x,%directe,%girat,%fraccions,$stringFraccions);

$fraccions{"1"} ='d`ecima d`ecimes';
$fraccions{"2"} ='cent`esima cent`esimes';
$fraccions{"3"} ='mil-l`esima mil-l`esimes';
$fraccions{"4"} ='deumil-l`esima deumil-l`esimes';
$fraccions{"5"} ='centmil-l`esima centmil-l`esimes';
$fraccions{"6"} ='milion`esima milion`esimes';
$fraccions{"7"} ='deumilion`esima deumilion`esimes';
$fraccions{"8"} ='centmilion`esima centmilion`esimes';


$stringFraccions = join(' ',sort(values %fraccions));
#$stringFraccions = fusionaDiacritics($stringFraccions);
$stringFraccions =~ s/`e/./g;
$stringFraccions =~ s/ /\|/g;
$stringFraccions = '('.$stringFraccions.')';

sub zeroXifra {
my $text=$_[0];
while (length($text)<$_[1]) {$text = '0'.$text}
return $text;
}

sub senseFonet {
my $x = shift;
$x =~ s/--/-/g;
$x =~ s/  / /g;
$x =~ s/ -/ /g;
$x =~ s/^-//;
$x =~ s/^ //;
$x =~ s/ $//;
$x =~ s/<//g;
$x =~ s/>//g;
$x = lc($x);
$x =~ s/\/o/ó/;
return $x;
}

sub inicialitza {
$girat{"0"} ='ZERO';
$girat{"1"} ='UN';
$girat{"1"} ='UNA' if $genere == 2;
$girat{"2"} ='D<OS';
if ($genere > 1)
        {
        $girat{"2"} ='DUGUES';
        $girat{"2"} ='DUES' if $estil == 1;
        }
$girat{"3"} ='TRES';
$girat{"4"} ='QUATRE';
$girat{"5"} ='CINC';
$girat{"6"} ='SIS';
$girat{"7"} ='SET';
$girat{"8"} ='VUIT';
$girat{"9"} ='-NOU';

$girat{"10"} ='D>EU';
$girat{"11"} ='<ONZE';
$girat{"12"} ='D<OTZE';
$girat{"13"} ='TR<ETZE';
$girat{"14"} ='CATORZE';
$girat{"15"} ='QUINZE';
$girat{"16"} ='SETZE';
$girat{"17"} ='DISSET'; # dèsset, dihuit, dènou
$girat{"18"} ='DIVUIT';
$girat{"19"} ='DINOU';

$girat{"20"} ='VINT';
$girat{"30"} ='TRENTA';
$girat{"40"} ='QUARANTA';
$girat{"40"} ='CORANTA' if $estil == 2;
$girat{"50"} ='CINQUANTA';
$girat{"60"} ='SEIXANTA';
$girat{"60"} ='XIXANTA' if $estil == 2;
$girat{"70"} ='SETANTA';
$girat{"80"} ='VUITANTA';
$girat{"90"} ='NORANTA';
$girat{"90"} ='NOURANTA' if $estil == 2;
}


$estil =1;
$genere = 1;
$tipusComa= '\.,';
$precisioDecimals=3;
inicialitza;

for (my $j=1;$j<21;$j++) {
        $x = cardinal($j);
        $x = senseFonet($x);
        $directe{$x}=$j;
        }

for (my $j=2;$j<10;$j++) {
        $x = cardinal($j*10);
        $x = senseFonet($x);
        $directe{$x}=$j*10;
        }

$directe{"vint-i"}=20;
$directe{"dues"}=2;
$directe{"una"}=1;
$directe{"u"}=1;


########################

sub cardinalSota1000 {
my $depurem = 0;
my $modificat = $_[0];
return 'ZERO' if $modificat == 0;
my ($cents,$desenes,$unitats,$k);
$cents=int($modificat / 100);
$modificat=$modificat - ($cents*100);
##########
if ($modificat > 20) {
        $desenes=int($modificat / 10)*10;
        $unitats=$modificat - $desenes;
        }
else {
        $desenes=1;
        $unitats=$modificat;
        }
##########
$modificat='';
if ($cents > 1) {
        $modificat = $girat{$cents}.'-C<ENT';
        $modificat .= 'E' if ($genere > 1);
        $modificat .= 'S';
        }
elsif ($cents == 1) {$modificat='C<ENT'}

return $modificat if $desenes+$unitats == 1;

if ($desenes == 1) {$modificat .= ' '.$girat{$unitats}}
elsif ($desenes > 19) {
        $modificat .= ' '.$girat{$desenes};
        $modificat .= '-I' if $desenes == 20;
        $modificat .= '-'.$girat{$unitats} if $unitats>0;
        }
$modificat =~ s/^ //;
return $modificat;
}

sub verbalitzaCardinal {
my $modificat = $_[0];
return 'ZERO' if $modificat == 0;
my ($milers,$submilers,$supramilers,$generePrevi);
my $verbal='';
if ($modificat < 0) {$verbal='MENYS ';$modificat=abs($modificat)}
if ($modificat > 1000000*1000000) {return 'ics'} # un bili'o com a m`axim
if ($modificat == 1000000*1000000) {return $verbal.'UN BILI/O'}
if ($modificat > 1000000) {
        $supramilers=int($modificat / 1000000);
        $milers=$modificat - ($supramilers*1000000);
        $generePrevi=$genere;
        $genere = 1;
        inicialitza unless $genere == $generePrevi;
        if ($supramilers == 1) {$verbal .= 'UN MILI/O';}
        else {$verbal .= verbalitzaCardinal($supramilers).' MILI<ONS';}
        if ($genere != $generePrevi) {
                $genere=$generePrevi;
                inicialitza;
                }
        $verbal .= ' '.verbalitzaCardinal($milers) if $milers;
        return $verbal;
        }
if ($modificat == 1000000) {return $verbal.'UN MILI/O'}
$milers=int($modificat / 1000);
$submilers=$modificat - ($milers*1000);
if ($milers == 1) {$verbal .= 'MIL'}
elsif ($milers > 1) {$verbal .= cardinalSota1000($milers).' MIL'}
if ($submilers>0) {
        $verbal .=' '.cardinalSota1000($submilers);
        }
$verbal =~ s/^ //;
return $verbal;
}

sub cardinal {
my $modificat = $_[0];
my ($generePrevi,$decimals,$partDecimal,$forma,@singPlur);
if ($modificat =~ /^(\d{1,14})([$tipusComa])(\d{1,14})$/) { #tractem igual punt o coma
        if ($precisioDecimals>6 ) {$precisioDecimals=6}
        $partDecimal=$3;
        $decimals=length($partDecimal);
        if ($decimals > $precisioDecimals) {
                $partDecimal=substr($partDecimal,0,$precisioDecimals);
                $decimals=length($partDecimal);
                }
        $modificat=$1;
        $forma = 'PUNT';
        $forma = 'COMA' if $2 eq ',';
        $modificat=verbalitzaCardinal($modificat);
        $generePrevi=$genere;
        $genere = 2;
        inicialitza unless $genere == $generePrevi;
        if (exists ($fraccions{$decimals})) {
                $decimals = $fraccions{$decimals};
#               $decimals = fusionaDiacritics($decimals);
                @singPlur=split(/ /,$decimals);
                $decimals = $singPlur[1];
                $decimals = $singPlur[0] if $partDecimal == 1;
                }
        else
                {
                $decimals='fraccioDesconeguda';
                }
        $partDecimal=verbalitzaCardinal($partDecimal);
        if ($genere != $generePrevi) {
                $genere=$generePrevi;
                inicialitza;
                }
# convertir a decimes,,...
        return $modificat." $forma ".$partDecimal.' '.$decimals;
        }
return verbalitzaCardinal($modificat);
}

sub roma2valor {
my $antic = lc($_[0]);
if ($antic =~ /^(ix?|[dl]i|vii?|mi[xlm]?)$/) {return 0}
$antic =~ s/ix/viiii/;
$antic =~ s/iv/iiii/;
$antic =~ s/xl/xxxx/;
$antic =~ s/xc/lxxxx/;
$antic =~ s/cd/cccc/;
$antic =~ s/cm/dcccc/;
my $segon=0;
my $lletra=' ';
for (my $i=0;$i<length($antic);$i++) {
        $lletra=substr($antic,$i,1);
        if ($lletra eq 'i') {$segon+=1}
        elsif ($lletra eq 'v') {$segon+=5}
        elsif ($lletra eq 'x') {$segon+=10}
        elsif ($lletra eq 'l') {$segon+=50}
        elsif ($lletra eq 'c') {$segon+=100}
        elsif ($lletra eq 'd') {$segon+=500}
        elsif ($lletra eq 'm') {$segon+=1000}
        else {return 0};
        }
return $segon;
}

########################### subrutines

sub centenes2xifra {
my $interior = shift;
my ($xe,$xd);
return $directe{$interior} if exists($directe{$interior});
if ($interior =~ /^(vint-i|trenta|quaranta|cinquanta|seixanta|setanta|vuitanta|noranta)-(un|u|una|dos|dues|tres|quatre|cinc|sis|set|vuit|nou)$/) {
        $xe=$directe{$1};
        $xd=$directe{$2};
        return $xe+$xd;
        }
return 0;
}

sub milers2xifra {
my $interior = shift;
my ($e,$d,$xe,$xd);
return 100 if $interior eq 'cent';
if ($interior =~ /^(dos|dues|tres|quatre|cinc|sis|set|vuit|nou)-cente?s ([A-Za-z\-]+)$/) {
        $e=$1;
        $d=$2;
        $xe=$directe{$e};
        $xd=centenes2xifra($d);
        if ($xe) {$xe *= 100} else {$xe=0};
        if ($xd) {$xe += $xd}
        return $xe;
        }
elsif ($interior =~ /^(dos|dues|tres|quatre|cinc|sis|set|vuit|nou)-cente?s$/) {
        $xe=$directe{$1};
        if ($xe) {$xe *= 100} else {$xe=0};
        return $xe;
        }
elsif ($interior =~ /^cent ([A-Za-z\-]+)$/) {
        $xe=centenes2xifra($1);
        return $xe+100;
        }
$e=centenes2xifra($interior);
return $e if $e;
return 0;
}

sub milions2xifra {
my $interior = shift;
my ($e,$d,$xe,$xd);
return 1000 if $interior eq 'mil';
if ($interior =~ /^([A-Za-z\- ]+) mil ([A-Za-z\- ]+)$/) {
        $e=$1;
        $d=$2;
        $xe=milers2xifra($e);
        $xd=milers2xifra($d);
        if ($xe) {$xe *= 1000} else {$xe=0};
        if ($xd) {$xe += $xd}
        return $xe;
        }
elsif ($interior =~ /^([A-Za-z\- ]+) mil$/) {
        $xe=milers2xifra($1);
        if ($xe) {$xe *= 1000} else {$xe=0};
        return $xe;
        }
elsif ($interior =~ /^mil ([A-Za-z\- ]+)$/) {
        $xe=milers2xifra($1);
        return $xe+1000;
        }
elsif ($interior =~ /^([A-Za-z\- ]+)$/) {
        $xe=milers2xifra($1);
        return $xe;
        }
return 0;
}

sub cardinal2xifra {
my $interior = shift;
my ($e,$d,$xe,$xd,$c,$f);
if ($interior =~ /^menys ([A-Za-z\- ]+)$/) {
        $xe=cardinal2xifra($1);
        return "-$xe";
        }

elsif ($interior =~ /^([A-Za-z\- ]+)( coma | punt )([A-Za-z\- ]+) $stringFraccions$/) {
        $xe=$1;
        $xd=$3;
        $f=$4;
        $c=$2;
        if ($c eq ' coma ') {$c=','} else {$c='.'};
        if ($f =~ /d.cim(a|es)/) {$f=1}
        elsif ($f =~ /cent.sim(a|es)/) {$f=2}
        elsif ($f =~ /mil-l.sim(a|es)/) {$f=3}
        elsif ($f =~ /deumil-l.sim(a|es)/) {$f=4}
        elsif ($f =~ /centmil-l.sim(a|es)/) {$f=5}
        elsif ($f =~ /milion.sim(a|es)/) {$f=6}
        elsif ($f =~ /deumilion.sim(a|es)/) {$f=7}
        elsif ($f =~ /centmilion.sim(a|es)/) {$f=8};
        $xe=cardinal2xifra($xe);
        $xd=cardinal2xifra($xd);
        $xd=zeroXifra($xd,$f) if length($xd)<$f;
        return "$xe$c$xd";
        }
elsif ($interior =~ /^([A-Za-z\- ]+)( coma | punt )([A-Za-z\- ]+)$/) {
        $xe=$1;
        $xd=$3;
        $c=$2;
        if ($c eq ' coma ') {$c=','} else {$c='.'}
        $xe=cardinal2xifra($xe);
        $xd=cardinal2xifra($xd);
        return "$xe$c$xd";
        }
elsif ($interior =~ /^([A-Za-z\- ]+) milions ([A-Za-z\- ]+)$/) {
        $e=$1;
        $d=$2;
        $xe=milions2xifra($e);
        $xd=milions2xifra($d);
        if ($xe) {$xe *= 1000000} else {$xe=0};
        if ($xd) {$xe += $xd}
        return $xe;
        }
elsif ($interior =~ /^un mili[ó—] ([A-Za-z\- ]+)$/) {
        $xe=milions2xifra($1);
        return $xe+1000000;
        }
elsif ($interior =~ /^un mili[ó—]$/) {
        return 1000000;
        }
elsif ($interior =~ /^([A-Za-z\- ]+)$/) {
        $xe=milions2xifra($1);
        return $xe;
        }
return $interior;
}


########################

# accions d'inicialització

########################

1;                            # final del modul


Per comentaris i observacions, poseu-vos en contacte amb de_yza@upf.es Lluís de Yzaguirre i Maura

Pàgina servida per Apache