#! perl.exe -w # Copyright (c) 2010, L.V. # This library is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # use strict; use utf8; use Math::BigFloat; use Scalar::Util 'looks_like_number'; binmode STDOUT, ":encoding(UTF-8)"; use constant { WS => ' ', # word separator TS => ' ', # triad separator DS => ' ', # tens-digits separator, e.g., seventy-eight CN => 'lit', # [c]ount [n]oun (w/o ending if inflectional) WITH_CN => 1, # 0 - 19 N_0_19 => [ qw { nulis vienas du trys keturi penki šeši septyni aštuoni devyni dešimt vienuolika dvylika trylika keturiolika penkiolika šešiolika septyniolika aštuoniolika devyniolika } ], # 0, 10, 20, ... 90 N_TENS => [ qw { nulis dešimt dvidešimt trisdešimt keturiasdešimt penkiasdešimt šešiasdešimt septyniasdešimt aštuoniasdešimt devyniasdešimt } ], # 100, 10^(3*n) (n: 1 .. 10) N_EXPT => [ qw { šimt tūkstan milijon milijard trilijon kvadrilijon kvintilijon sikstilijon septilijon oktilijon naintilijon } ], # Endings of various (possible) gramatical cases; used by the case # finding function which returns actual ending. # lt: vns. vardininkas, dgs. vardininkas, kilmininkas. CE => [ [ qw {as ai ų} ], # šimt(-as, -ai, -ų) [ qw {tis čiai čių} ], # tūkstan(-tis, -čiai, -čių) ], }; my @words = (); # Returns ending for the particular case according to case-variant # (cv) (normally triad number) and double-figure (df) number value # and optional arguments (count noun flag). sub ce_( $$;$ ) { my ($cv, $df, $opt) = @_; my $d = $df % 10; # case or count noun endings my @e = ( $opt && $opt eq 'cn' ) ? @{ CE->[0] } : @{ CE->[ ($cv == 1) ? 1 : 0 ] }; # [0-9][0], [11-19]: pl. genitive (lt: dgsk. kilmininkas; -ū, -čių) if ( $d == 0 || $df ~~ [11 .. 19] ) { return $e[2]; } # [0-9][1]: sg. nominative (lt: vnsk. vardininkas; -as, -tis) elsif ( $d == 1 ) { return $e[0]; } # [0,2-9][2-9]: pl. nominative (lt: dgsk. vardininkas; -ai, -čiai) else { return $e[1]; } } # Returns ending for the [c]ount [n]oun according to # double-figure (df) value sub cn_ce_( $ ) { my $df = shift; return ce_ (0, $df, 'cn'); } # Convert number to triad-grouped list of digits sub num2tlist( $ ) { my $n = Math::BigFloat -> new( shift ) -> babs() -> bfloor(); # prepend zeroes to complete the highest triad $n = '0' x eval { my $r = $n->length % 3; $r ? 3 - $r : 0; } . $n; # split number string into (triad-grouped) substrings (list items) return unpack('(A3)*', $n); } sub triad { my $tn = shift; my ($d1, $d2, $d3) = split('', $_); my $df = $d2 * 10 + $d3; ($d1 || $df) || return 0; push(@words, # triad separator @words ? TS : '', # [1-9]xx -------------------------- $d1 ? ( N_0_19->[$d1], WS, N_EXPT->[0] . ce_(0, $d1) ) : '', ($d1 && $df) ? WS : '', # 20-99 ---------------------------- $df > 19 ? ( N_TENS->[$d2], $d3 ? ( DS, N_0_19->[$d3] ) : '' ) # 01-19 ---------------------------- : ( $df ? ( N_0_19->[$df] ) : '' ), # triad (value) name $tn > 0 ? ( WS, N_EXPT->[$tn] . ce_($tn, $df) ) : '' ); return $df; } sub num2words ( $;$ ) { my $arg = shift; my $opt = shift; my $ldf; # last double figure my $with_cn = WITH_CN; if ( ref($opt) eq 'HASH' && exists $opt->{'with-cn'} ) { $with_cn = $opt->{'with-cn'}; } looks_like_number($arg) || die "'$arg' is not a (recognized) number"; my @t = num2tlist( $arg ); my $tn = @t - 1; # size of array (triad number) ($tn <= 10) || die "can't handle numbers bigger than 10^30"; @words = (); map { $ldf = triad($tn--, $_) } @t; if ( $with_cn ) { push(@words, WS, CN, cn_ce_($ldf)); } return join ('', @words); } print num2words("123456789123456789"), "\n"; print num2words("100056009000406780.77"), "\n"; print num2words("-123456", {'with-cn' => 0}), "\n"; print num2words("-1701019", {'with-cn' => 1}), "\n";