#! 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";