Tema: Re: REQ: PERL suma zodziu
Autorius: Laimis
Data: 2010-03-08 03:43:25
#! 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";