package Lingua::FI::Inflect;
use 5.008;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(taivuta to_number %sijamuodot) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );
our $VERSION = '0.02';
our %sijamuodot=(
monikko => 0,
genetiivi => 1,
inessiivi => 2,
elatiivi => 3,
adessiivi => 4,
ablatiivi => 5,
partitiivi => 6,
essiivi => 7,
illatiivi => 8,
translatiivi=> 9,
);
# haluaa taivuttamattoman sanan
# palauttaa taivutetun sanan
sub taivuta{
my($sijamuoto_id,$sana)=@_;
# järjestä ao. lista ensin pituuden mukaan, sitten aakkosjärjestykseen
# konsonantit
# viimeinen id=6
my $k ="bcdfghjklmnpqrstvwxz";
my $k2="smnl";
my $k5="k";
my $k4="lr";
my $k3="vh";
my $k6="h";
my $k7="kptq";
# järjestä ao. lista ensin pituuden mukaan, sitten aakkosjärjestykseen
# vokaalit
# viimeinen id=2
my $v ="aeiouy:;";
my $v2="i";
# muuta ä-kirjaimet kaksoispisteiksi ja ö-kirjaimet puolipisteiksi
# hae käytetäänkö sanassa skandeja vai ei
# $a == a tai ä
# $o == o tai ö
(local $_,my $a,my $o)=to_number($sana);
# määritä sijamuodon sijapääte $p-muuttujaan
# määritä $p1-muuttujaan sijapääte ilman skandeja
# määritä $p2-muuttujaan sijapääte skandeilla varustettuna
my($p)=(
$sijamuoto_id == 0 ? "t" # monikko
: $sijamuoto_id == 1 ? "n" # genetiivi
: $sijamuoto_id == 2 ? "ss$a" # inessiivi
: $sijamuoto_id == 3 ? "st$a" # elatiivi
: $sijamuoto_id == 4 ? "ll$a" # adessiivi
: $sijamuoto_id == 5 ? "lt$a" # ablatiivi
: $sijamuoto_id == 6 ? "$a" # partitiivi
: $sijamuoto_id == 7 ? "n$a" # essiivi
: $sijamuoto_id == 8 ? "$a"."n" # illatiivi
: $sijamuoto_id == 9 ? "ksi" # translatiivi
: die "Wrong case");
(my $p1=$p) =~ tr/y:;/uao/;
(my $p2=$p) =~ tr/aou/:;y/;
# 1 = regex
# 2 = käytettävän säännön id; viimeinen id = 111
# 3 = esimerkkisanan alku
# 4 = esimerkkisanan loppu ; isolla kirjaimet, jotka ovat aina juuri nämä
# 5 = esimerkkisanan lopun käännös ; isolla kirjaimet, jotka ovat aina juuri nämä
# 6 = ryhmän id, johon regex kuuluu; viimeinen id = 10
# 7 = ryhmän järjestys; pienin ensin. Laita perään +, jos järjestys jaetaan jonkun muun kanssa
#
# 1 2 3 4 5 6 7
# illatiivi (kotiin)
$sijamuoto_id == 8 && (
s/(.*[$v])([$v]) $ /$1$2h$2n !77 /x
# poikkeukset
|| s/^([th])(uu?l)i $ /$1$2een !92 /x
|| s/^kivi $ /kiveen !93 /x #
# monikko
|| s/(.*)([$v])(\2)t $ /$1$2isiin !94 /x # lampaat lampaisiin
|| s/(.*)([$k])([a:])t $ /$1$2$o\0ihin!95 /x # perunat perunoihin
|| s/(.*)(s) $ /$1kseen !96 /x # sirkus kseen
|| s/(.*)(e) $ /$1$2$2seen !78 /x # hame hameeseen
|| s/(.*)(nk)(i) $ /$1$2een !79 /x # henki henkeen
|| s/(.*)([$v]) $ /$1$2$2n !80 /x # kissa kissaan
|| s/(.*)([$k]+) $ /$1$2iin !81 /x # kiss kissiin
)
# partitiivi
|| $sijamuoto_id == 6 && (
s/(.*[$v])([$v]) $ /$1$2t$a !82 /x
# poikkeukset
|| s/^([th])(uu?l)i $ /$1$2ta !108/x #
|| s/^kivi $ /kive$a !98 /x #
# monikko
|| s/(.*)([$v])(\2)t $ /$1$2it$a !99 /x # lampaat lampaita
|| s/(.*)([$v])([$k])([a:])t $ /$1$2$3$o\0it$a!100/x # perunat perunoita
|| s/(.*)([$k])([a:])t $ /$1$2$o\0j$a ! /x # aika aikoja
|| s/(.*)([$k])([$v])t $ /$1$2$3j$a ! /x # jauhot jauhoja
|| s/(.*)(s) $ /$1$2ta !109/x # sirkus ta
|| s/(.*)(e) $ /$1$2tt$a !83 /x # hame hametta
|| s/(.*)(nk)(i) $ /$1$2e$a !84 /x # henki henkeä
|| s/(.*)([$v]) $ /$1$2$a !85 /x # kissa kissaa
|| s/(.*)([$k]+) $ /$1$2i$a !86 /x # kiss kissiä
)
# essiivi
|| $sijamuoto_id == 7 && (
s/(.*[$v])([$v]) $ /$1$2n$a !87 /x
# poikkeukset
|| s/^([th])(uu?l)i $ /$1$2ena !110/x
|| s/^kivi $ /kiven$a !102/x #
# monikko
|| s/(.*)([$v])(\2)t $ /$1$2in$a !103/x # lampaat lampaina
|| s/(.*)([$k])([a:])t $ /$1$2$o\0in$a!104/x # perunat perunoina
|| s/(.*)(s) $ /$1ksena !111/x # sirkus ksena
|| s/(.*)(e) $ /$1$2$2n$a !88 /x # hame hameena
|| s/(.*)(nk)i $ /$1$2en$a !89 /x # henki henkenä
|| s/(.*)([$v]) $ /$1$2n$a !90 /x # kissa kissana
|| s/(.*)([$k]+) $ /$1$2in$a !91 /x # kiss kissinä
)
# lainasanat, jotka päättyvät vokaaliin
|| s/(
andante
|anime
|apache
|appassionato
|beta
|beeta
|blanko
|byte
|delta
|data
|desi
|curry
|copy
|collie
|college
|chippendale
|city
|bluffi
|beige
|bridge
|boutique
|cache
|case
|deadline
|freestyle
|foto
|fleece
|empire
|epo
|esperanto
|extreme
|fluori
|expo
|folklore
|ellipsi
|ensemble
|forte
) $ /$1$p !59 /x
# lainasanat, jotka päättyvät konsonanttiin
|| s/(
blues
|charleston
|evergreen
|automarket
|bouquet
|bullshit
|burnout
|chat
|debet
|et
|exit
|fahrenheit
|kermit
) $ /$1i$p !60 /x
# monikko
|| /t$/ && (
s/([a:])t $ /$o\0i$p !105/x # kal AT oi 10 2
|| s/([$v])t $ /$1$p !106/x # pul u u
|| s/(.) $ /$1i$p !107/x # marke T tIT
)
# numerot 8-10
|| s/(
seitsem:
|ykdeks:
|kahdeksa
|kymmene
)n $ /$1$p !73 /x # 10 1
# säännöt, jotka toimivat myös nimille
|| s/nen $ /se$p !22 /x # kisu NEN SEN 10 2
# nimet
|| s/^([A-Z45].*)([$k7])\2([$v])$ /$1$2$3$p !67 /x # Ja tta ta 9 0
|| s/^([A-Z45].*[$v]) $ /$1$p !61 /x # Vil e e 9 1
|| s/^([A-Z45].*) $ /$1i$p !62 /x # Ki m mI 9 2
# pronominit
|| $sijamuoto_id == 0 && (
s/^min: $ /me !63 /x
|| s/^sin: $ /te !63 /x
|| s/^h:n $ /he !63 /x
|| s/^t:m: $ /n:m: !63 /x
|| s/^tuo $ /nuo !63 /x
|| s/^se $ /ne !63 /x
)
|| (
s/^min: $ /minu$p1 !63 /x
|| s/^sin: $ /sinu$p1 !63 /x
|| s/^h:n $ /h:ne$p2 !63 /x
|| s/^me $ /meid:$p2 !63 /x
|| s/^te $ /teid:$p2 !63 /x
|| s/^he $ /heid:$p2 !63 /x
|| s/^n:m: $ /n:ide$p2 !63 /x
|| s/^nuo $ /noide$p1 !63 /x
|| s/^ne $ /niide$p2 !63 /x
|| s/^t:m: $ /t:m:$p2 !63 /x
|| s/^tuo $ /tuo$p1 !63 /x
|| s/^se $ /se$p2 !63 /x
)
# yksittäiset sanat, joita ei voi laittaa yhdyssanaan
|| s/^aika $ /aja$p !64 /x # vrt. taika -> taia
|| s/^([th])(uu?l)i $ /$1$2e$p !64 /x # vrt. kuli -> kulin
# yksittäiset sanat, mahdolliset myös yhdyssanoissa
|| s/poika $ /poja$p !66 /x # reliikki
|| s/mies $ /miehe$p !66 /x # vrt. hies -> hiekse
|| s/yhteys $ /yhteyde$p !66 /x # vrt. risteys -> risteykse
|| s/haku $ /hau$p !66 /x # vrt. laku -> laku
|| s/laki $ /lai$p !66 /x # vrt. khaki -> khaki
|| s/tuoli $ /tuoli$p !66 /x # vrt. huoli -> huole
|| s/henki $ /henge$p !66 /x # vrt. renki -> rengi
|| s/puomi $ /puomi$p !66 /x # vrt. luomi -> luome
|| s/(th])uli $ /$1uule$p !66 /x # vrt. muuli -> muuli
|| s/nauris $ /naurii$p !66 /x
|| s/veli $ /velje$p !66 /x # vrt. peli -> peli
|| s/ruis $ /rukii$p !66 /x
|| s/ananas $ /ananakse$p !66 /x
|| s/business $ /businekse$p !66 /x
|| s/kirves $ /kirvee$p !66 /x
# numerot 1-6
|| s/(y|ka)ksi $ /$1hde$p !1 /x
|| s/(kolme|nelj:) $ /$1$p !1 /x
|| s/^(vii)si $ /$1de$p !1 /x # numero - kuitenkin aviisi -> aviisi
|| s/(kuu)si $ /$1de$p !1 /x
# numerot 11-19
|| s/(.+)(toista) $ /(taivuta($sijamuoto_id,$1))[0].$2.'!74' /ex
# järjestysluvut 1-10
|| s/(
yhde
|kahde
|kolma
|nelj:
|viide
|kuude
|seitsem:
|kahdeksa
|yhdeks:
|kymmene
)s $ /$1nne$p !75 /x
# varmat säännöt, joissa etsimisosan säännöt ovat ilman muuttujia (esim. $1)
|| s/^([vm])(er)i $ /$1$2e$p !33 /x # vERI > verE
|| s/(n)si $ /$1$1e$p !38 /x # ka NSI > nnE
|| s/(m)pi $ /$1$1e$p !11 /x # la MPI > mmE
|| s/(iel)i $ /$1e$p !19 /x # k IELI > elE
|| s/([yu]psi) $ /$1$p !55 /x # r yPSI > ypsi 8 1
|| s/(p)(s)i $ /$1$2e$p !32 /x # la PSI > psE 8 2
|| s/d([a:])s $ /t$1$1$p !24 /x # hi DAS > TAA
|| s/([st])(([ou]u)|([;y]y))s$ /$1$2de$p !44 /x # out oUS > ouDE
|| s/([$v])\1 $ /$1$1$p !58 /x # atelj ee > ee
# sekalaiset säännöt
|| s/(m)\1([a:])s $ /$1p$2$2$p !41 /x # ha MmAS > hamPaa 3 -2
|| s/(n)\1([a:])s $ /$1$1$2kse$p !42 /x # ka NnAS > nnaKSE 3 0
|| s/([$k])\1([a:])s $ /$1t$2$2$p !36 /x # ma llAS > malTaa 3 -1
|| s/([$k])d([a:])s $ /$1t$2$2$p !40 /x # a hDAS > ahTaa 3 -0.5
|| s/(n)\1e $ /$1tee$p !12 /x # la NnE > nTEE 3 1+
|| s/(m)\1e $ /$1$1ee$p !13 /x # a MmE > mmEE 3 1+
|| s/([$k2])\1([$v]) $ /$1$1$2$p !29 /x # ki ssa > ssa 3 2
|| s/([$k7])\1([$v]) $ /$1$2$p !02 /x # ta tti > ti
|| s/(r)si $ /$1$1e$p !43 /x # vi RSI > rrE
|| s/(sv|rm|sm)(i) $ /$1$2$p !68 /x # ka RmI > rmI
|| s/([$k])([$k3])$v2 $ /$1$2e$p ! 3 /x # hi rvi > rvE
|| s/([$v])\1s $ /$1$1de$p ! 4 /x # tilais uus > uuDE 1 1
|| s/([$v])([$v])s $ /$1$2kse$p ! 5 /x # lauk auS > auKSE 1 2
|| s/([$v])([$v])k([a:]) $ /$1$2$3$p ! 9 /x # s iiKA > iiA
|| s/([$v])p([$v]) $ /$1v$2$p !16 /x # n aPa > aVa
|| s/([$v])([$k])([a:])s $ /$1$2$2$3$3$p!25 /x # hi DAS > TAA 4 0
|| s/([$k])([$k])([a:])s $ /$1$2$3$3$p !37 /x # ka rvAS > karvaa 3 0
|| s/([$v])s $ /$1kse$p !23 /x # tik aS > aKSE 4 1
|| s/(tt)([$v])n $ /$1$2i$p !28 /x # 4 3
|| s/(t)(i)n $ /$1$1$2me$p !45 /x # lii TIN > ttiME 4 4+
|| s/(t)([o;])n $ /$1$1$2m$a$p !26 /x # ehdo TON > ttoMA 4 4+
|| s/(l)(i)n $ /$1$2me$p !30 /x # puhe LIN > liME 4 4+
|| s/(e)(n) $ /$1$2e$p !49 /x # ahv EN > enE 4 5
|| s/([$v])([$k]) $ /$1$2i$p !17 /x # kerm it > itI 4 6
|| s/([$v])(\1si) $ /$1$2$p !52 /x # m uuSI > uusi 6 1
|| s/([$v])si $ /$1de$p ! 6 /x # ka uSI > uDE 6 2
|| s/([$v])(t)(e) $ /$1$2$2$3$3$p!20 /x # ka TE > ttee 2 -2
|| s/d(e) $ /t$1$1$p !21 /x # kai DE > Tee 2 -1
|| s/(sk)(e) $ /$1$2$2$p !50 /x # rui SKE > skee 2 -0.5
|| s/(k)(e) $ /$1$1$2$2$p !46 /x # pil KE > kkee 2 -0.5
|| s/(e) $ /$1$1$p !18 /x # ven E > ee 2 0
|| s/(te[$k6])ti $ /$1di$p !56 /x # arkki TEhTI > tehDI 2 1.1
|| s/(e[$k6])ti $ /$1de$p !57 /x # le hTI > hDE 2 1.2
|| s/([$k6])t([$v]) $ /$1d$2$p !27 /x # jo hTo > hDo 2 1
|| s/([$v])t([$v]) $ /$1d$2$p !10 /x # ha uTa > uDa 2 2
|| s/([$k])(i)(v)i $ /$1$2$3e$p !14 /x # k ivI > ivE 2 3
|| s/([$k])([o;])([$k])i $ /$1$2$3i$p !51 /x # aero sOlI > olI 5 1
|| s/([o;]ni) $ /$1$p !54 /x # p ONI > oni 5 3
|| s/([o;])\1([$k])i $ /$1$1$2i$p !69 /x # b OolI > ooli 5 4
|| s/([o;])([$k])i $ /$1$2e$p !31 /x # hu OlI > olE 5 5
|| s/([$k4])t([a:]) $ /$1$1$2$p ! 7 /x # si lTA > llA
|| s/(n)k([$v]) $ /$1g$2$p !28 /x # la NKo > ngo
|| s/(n)t([$v]) $ /$1$1$2$p !15 /x # ka NTo > nno
|| s/((au)|(:y))ki $ /$1e$p !47 /x # h AUKI > auE
|| s/([o;]im|ie[$k])i $ /$1e$p !48 /x # t OIMI > oimE
|| s/(l)t([$v]) $ /$1$1$2$p !70 /x # pe LTi > lli
|| s/(l)k([i]) $ /$1je$p !72 /x # ky LKI > lJE
|| s/(l)k([a:]) $ /$1$2$p !71 /x # su LKa > a
# perussäännöt
|| s/([$v]) $/$1$p ! 8 /x # kirj a > a 7 1
|| s/(.*) $/$1i$p !53 /x # aid S > sI 7 2
;
tr/:;/\ä\ö/;
m/^(.*?) *!(.*)/;
return $1,$2;
}
# change scandinavic letters 'ä' to ':' and 'ö' to ';' in the given word
# return changed word,a-skand,o-scand
# a-skand == 'a' if scands are not used and ':' if they are
# o-skand == 'o' if scands are not used and ';' if they are
sub to_number{
my($temp)=@_;
my($muisti,$apu,$scand)=undef;
$scand=1;
foreach my $kirjain(split //,$temp){
my $ascii=ord($kirjain);
if($ascii == 195){
$muisti=1;
}else{
if($ascii == 164 && $muisti){
$kirjain=":";
}elsif($ascii == 182 && $muisti){
$kirjain=";";
}
$muisti=0;
$apu.=$kirjain;
}
$scand=1 if $kirjain =~ /[y:;]/;
$scand=0 if $kirjain =~ /[aou]/;
}
return $apu,$scand ? ":" : "a",$scand ? ";" : "o";
}
1;
__END__
=head1 NAME
Lingua::FI::Inflect - Finnish inflect
=head1 NIMI
Lingua::FI::Inflect - suomen taivutus
=head1 SYNOPSIS
use Lingua::FI::Inflect qw(taivuta to_number %sijamuodot);
my($inflected)=taivuta($sijamuodot{genetiivi},"kissa"); # inflects word "kissa" to its genitive
print $inflected; # prints "kissan"
or
use Lingua::FI::Inflect qw(taivuta to_number %sijamuodot);
foreach my $sijamuoto(sort keys %sijamuodot){ # käy läpi kaikki sijamuodot
my($taivutettu,$rule_id)=taivuta($sijamuodot{$sijamuoto},"kissa"); # taivuttaa sanan ko. sijamuotoon
print "$sijamuoto: $taivutettu (sääntö == $rule_id)\n";
}
=head1 KÄYTTÖ
use Lingua::FI::Inflect qw(taivuta to_number %sijamuodot);
my($taivutettu)=taivuta($sijamuodot{genetiivi},"kissa"); # taivuttaa sanan "kissa" genetiiviin
print $taivutettu; # tulostaa ruutuun "kissan"
tai
use Lingua::FI::Inflect qw(taivuta to_number %sijamuodot);
foreach my $sijamuoto(sort keys %sijamuodot){ # käy läpi kaikki sijamuodot
my($taivutettu,$rule_id)=taivuta($sijamuodot{$sijamuoto},"kissa"); # taivuttaa sanan ko. sijamuotoon
print "$sijamuoto: $taivutettu (sääntö == $rule_id)\n";
}
=head1 DESCRIPTION
taivuta() returns an inputted word inflected to the chosen case.
Supposes that given word is a name if the first letter is capilalized.
=head1 KUVAUS
taivuta() palauttaa annetun sanan taivutettuna haluttuun sijamuotoon.
Olettaa, että sana on nimi, mikäli ensimmäinen kirjain on iso.
=head1 KNOWN CASES AND HOW WELL THEY ARE BEING INFLECTED
CASE SINGULAR PLURAL
genetiivi very good poor
inessiivi good poor
elatiivi good poor
adessiivi good poor
ablatiivi good poor
partitiivi good poor
essiivi good poor
illatiivi good poor
translatiivi good poor
plural good -
Plural is being considered as one of the cases. For example if You want to inflect word "kissa" - that is cat - to plural translative, first inflect "kissa" to plural ("kissat") and then inflect "kissat" to translative ("kissoiksi").
=head1 TUETUT SIJAMUODOT JA NIIDEN TOIMIVUUS
SIJAMUOTO YKSIKKÖ MONIKKO
genetiivi erittäin hyvä huono
inessiivi hyvä huono
elatiivi hyvä huono
adessiivi hyvä huono
ablatiivi hyvä huono
partitiivi hyvä huono
essiivi hyvä huono
illatiivi hyvä huono
translatiivi hyvä huono
monikko hyvä -
Monikko tulkitaan ykdeksi sijamuodoista. Jos haluat esim taivuttaa yksikössä olevan sanan "kissa" monikon translatiiviin, taivuta "kissa" ensin monikkoon ("kissat") ja taivuta se sitten translatiiviin ("kissoiksi").
=head1 KNOWN BUGS
Doesn't know all odd words.
Works only the inputted word is non-inflected (plural is also ok).
What comes to names, works well only with Christian names.
Works good only with numbers smaller than twenty.
=head1 BUGIT
Ei tunne kaikkia erikoisesti taipuvia sanoja.
Toimii vain yksikön tai monikon perusmuodossa oleville sanoille.
Nimistä taivuttaa hyvin vain etunimet
Taivuttaa hyvin vain kahtakymmentä pienemmät luvut.
=head1 AUTHOR
Ville Jungman
<ville_jungman@hotmail.com, ville.jungman@frakkipalvelunam.fi>
If You just use this module or have some comments I would be glad to hear them.
=head1 OHJELMAN TEKIJÄ
Ville Jungman
<ville_jungman@hotmail.com, ville.jungman@frakkipalvelunam.fi>
Jos käytät tätä moduulia tai jos on jotain parannusehdotuksia, niin olis tosi hauskaa saada palautetta.
=head1 COPYRIGHT / TEKIJÄNOIKEUS
Copyright 2004 Ville Jungman
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 LISENSSI
Tämä kirjastomoduli on vapaa; voit jakaa ja/tai muuttaa sitä samojen
ehtojen mukaisesti kuin Perliä itseään.
=cut