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 |