Antonio Bonifati's Home Page

Farmer, Italian language teacher, Lisp functional programmer, sysadmin and free-software fellow

/*
Prolog rules to write an English ordinal number in words, with intended profile
ordinal(+,-), in_figure(+,-).

Range: from 0 up to 999,999,999,999,999 (a thousand trillion minus one)

Copyright 2010 Antonio Bonifati 
This software comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to modify and redistribute it under the GPL license
*/

:- include('in_words.pl').

% irregular
ordinal(1,first) :- !.
ordinal(2,second) :- !.
ordinal(3,third) :- !.

% spelling variations
ordinal(5,fifth) :- !.
ordinal(8,eighth) :- !.
ordinal(9,ninth) :- !.
ordinal(12,twelfth) :- !.

ordinal(N,W) :- N =< 19, in_words(N,CW), atom_concat(CW,th,W), !.

ordinal(N,W) :- N =< 99, T is N // 10, ten_var(T,V), U is N mod 10,
  (U == 0 -> atom_concat(V,tieth,W) ; ordinal(U,UW), concat_atom([V,ty,-,UW],W)), !.

ordinal(N,W) :- N =< 999, H is N // 100, in_words(H,HW), R is N mod 100,
  (R == 0 -> atom_concat(HW,' hundredth',W) ; ordinal(R,RW),
    concat_atom([HW,' hundred and ',RW],W)), !.

ordinal(N,W) :- nearest_power(N,P,PN), Q is N // P, in_words(Q,QW), R is N mod P,
  (R == 0 -> concat_atom([QW,' ',PN,th],W) ; ordinal(R,RW),
    L is P // 10, (R < L -> S = ' and' ; S = ,),
    concat_atom([QW,' ',PN,S,' ',RW],W)).

in_figure(N,W) :- U is N mod 10, fig_suffix(U,S), atom_concat(N,S,W).

fig_suffix(1,'st') :- !.
fig_suffix(2,'nd') :- !.
fig_suffix(3,'rd') :- !.
fig_suffix(U,'th').