Institut Universitari de Lingüística Aplicada Universitat Pompeu Fabra |
Lluís de Yzaguirre i Maura Tel 935.422.234 Fax 935.422.321 |
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 |