File Coverage

blib/lib/Lingua/SWE/Word2Num.pm

Criterion	Covered	Total	%
statement	23	45	51.1
branch	0	12	0.0
condition	2	4	50.0
subroutine	9	10	90.0
pod	3	3	100.0
total	37	74	50.0

# For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8; -*-

package Lingua::SWE::Word2Num;
# ABSTRACT: Word to number conversion in Swedish

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

use Export::Attrs;
use Parse::RecDescent;

# }}}
# {{{ variable declarations
our $VERSION = '0.2603300';
my $parser = sv_numerals();

# }}}

# {{{ w2n                                         convert text to number

sub w2n :Export {
    my $input = shift // return;

    return $parser->numeral($input);
}

# }}}
# {{{ sv_numerals                                 create parser for numerals

sub sv_numerals {
    return Parse::RecDescent->new(q{

      numeral: million   { return $item[1]; }                         # root parse. go from maximum to minimum value
        |      millenium { return $item[1]; }
        |      century   { return $item[1]; }
        |      decade    { return $item[1]; }
        |      number    { return $item[1]; }
        |                { return undef; }

      number: 'nitton'  { $return = 19; }                             # try to find a word from 0 to 19
        |     'arton'   { $return = 18; }
        |     'sjutton' { $return = 17; }
        |     'sexton'  { $return = 16; }
        |     'femton'  { $return = 15; }
        |     'fjorton' { $return = 14; }
        |     'tretton' { $return = 13; }
        |     'tolv'    { $return = 12; }
        |     'elva'    { $return = 11; }
        |     'tio'     { $return = 10; }
        |     'nio'     { $return = 9; }
        |     'åtta'    { $return = 8; }
        |     'sju'     { $return = 7; }
        |     'sex'     { $return = 6; }
        |     'fem'     { $return = 5; }
        |     'fyra'    { $return = 4; }
        |     'tre'     { $return = 3; }
        |     'två'     { $return = 2; }
        |     'ett'     { $return = 1; }
        |     'noll'    { $return = 0; }

      tens:   'tjugo'   { $return = 20; }                             # try to find a word that represents
        |     'trettio' { $return = 30; }                             # values 20,30,..,90
        |     'fyrtio'  { $return = 40; }
        |     'femtio'  { $return = 50; }
        |     'sextio'  { $return = 60; }
        |     'sjutio'  { $return = 70; }
        |     'åttio'   { $return = 80; }
        |     'nittio'  { $return = 90; }

      decade: tens(?) number(?)                                       # try to find words that represents values
              { $return = 0;                                          # from 0 to 99
                for (@item) {
                  $return += $$_[0] if (ref $_ && defined $$_[0]);
                }
                $return = undef if(!$return);
              }
      century: number(?) 'hundra' decade(?)                           # try to find words that represents values
               { $return = 0;                                         # from 100 to 999
                 for (@item) {
                   if (ref $_ && defined $$_[0]) {
                     $return += $$_[0];
                   } elsif ($_ eq 'hundra') {
                     $return = ($return>0) ? $return * 100 : 100;
                   }
                 }
                 $return = undef if(!$return);
               }
    millenium: century(?) decade(?) 'tusen' century(?) decade(?)      # try to find words that represents values
               { $return = 0;                                         # from 1.000 to 999.999
                 for (@item) {
                   if (ref $_ && defined $$_[0]) {
                     $return += $$_[0];
                   } elsif ($_ eq "tusen") {
                     $return = ($return>0) ? $return * 1000 : 1000;
                   }
                 }
                 $return = undef if(!$return);
               }

      million: millenium(?) century(?) decade(?)                      # try to find words that represents values
               'miljoner'                                             # from 1.000.000 to 999.999.999.999
               millenium(?) century(?) decade(?)
               { $return = 0;
                 for (@item) {
                   if (ref $_ && defined $$_[0]) {
                     $return += $$_[0];
                   } elsif ($_ eq 'miljoner') {
                     $return = $return ? $return * 1000000 : 1000000;
                   }
                 }
                 $return = undef if(!$return);
               }
    });
}

# }}}
# {{{ ordinal2cardinal          convert ordinal text to cardinal text

sub ordinal2cardinal :Export {
    my $input = shift // return;

    # Swedish ordinal→cardinal: reverse lookup for irregular forms,
    # suffix stripping for regular/compound forms.

    # Fully irregular 1-12
    my %irregular = (
        'första'    => 'ett',
        'andra'     => 'två',
        'tredje'    => 'tre',
        'fjärde'    => 'fyra',
        'femte'     => 'fem',
        'sjätte'    => 'sex',
        'sjunde'    => 'sju',
        'åttonde'   => 'åtta',
        'nionde'    => 'nio',
        'tionde'    => 'tio',
        'elfte'     => 'elva',
        'tolfte'    => 'tolv',
    );

    # Teens 13-19 (regular -de suffix on cardinal stem)
    my %teens = (
        'trettonde'  => 'tretton',
        'fjortonde'  => 'fjorton',
        'femtonde'   => 'femton',
        'sextonde'   => 'sexton',
        'sjuttonde'  => 'sjutton',
        'artonde'    => 'arton',
        'nittonde'   => 'nitton',
    );

    # Tens ordinals (-onde/-ionde suffix)
    my %tens = (
        'tjugonde'   => 'tjugo',
        'trettionde' => 'trettio',
        'fyrtionde'  => 'fyrtio',
        'femtionde'  => 'femtio',
        'sextionde'  => 'sextio',
        'sjuttionde' => 'sjutio',
        'åttionde'   => 'åttio',
        'nittionde'  => 'nittio',
    );

    # Exact match: standalone ordinals
    return $irregular{$input} if exists $irregular{$input};
    return $teens{$input}     if exists $teens{$input};
    return $tens{$input}      if exists $tens{$input};

    # Round hundreds: "hundrade" → "hundra", "tvåhundrade" → "tvåhundra"
    $input =~ s{hundrade\z}{hundra}xms and return $input;

    # Thousands ordinal: "tusende" → "tusen" (e.g. "etttusende" → "etttusen")
    $input =~ s{tusende\z}{tusen}xms   and return $input;

    # Compound matching — longest suffix first to avoid partial matches.
    # E.g. "sjuttionde" (10 chars) must match before "tionde" (6 chars).
    # Merge all suffix maps, sort by key length descending.
    my @all_suffixes;
    push @all_suffixes, map { [ $_, $tens{$_}      ] } keys %tens;
    push @all_suffixes, map { [ $_, $teens{$_}     ] } keys %teens;
    push @all_suffixes, map { [ $_, $irregular{$_} ] } keys %irregular;

    for my $pair (sort { length $b->[0] <=> length $a->[0] } @all_suffixes) {
        my ($ord, $cardinal) = @$pair;
        if ($input =~ m{\A(.+)\Q$ord\E\z}xms) {
            return $1 . $cardinal;
        }
    }

    return;  # not an ordinal
}

# }}}

1;

__END__