Antonio Bonifati's Home Page

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

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

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
*/

in_words(0,zero) :- !.
in_words(1,one) :- !.
in_words(2,two) :- !.
in_words(3,three) :- !.
in_words(4,four) :- !.
in_words(5,five) :- !.
in_words(6,six) :- !.
in_words(7,seven) :- !.
in_words(8,eight) :- !.
in_words(9,nine) :- !.

in_words(10,ten) :- !.
in_words(11,eleven) :- !.
in_words(12,twelve) :- !.
in_words(N,W) :- N =< 19, U is N mod 10, unit_var(U,V), atom_concat(V,teen,W), !.

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

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

/*
Notice how we merged these four symmetric rules into one:

in_words(N,W) :- N =< 999999, HT is N // 1000, in_words(HT,HTW), R is N mod 1000,
  (R == 0 -> atom_concat(HTW,' thousand',W) ; in_words(R,RW),
    (R =< 99 -> S = ' and' ; S = ,),
    concat_atom([HTW,' thousand',S,' ',RW],W)), !.

in_words(N,W) :- N =< 999999999, M is N // 1000000, in_words(M,MW),
  R is N mod 1000000, (R == 0 -> atom_concat(MW,' million',W) ; in_words(R,RW),
    (R =< 99999 -> S = ' and' ; S = ,),
    concat_atom([MW,' million',S,' ',RW],W)), !.

in_words(N,W) :- N =< 999999999999, B is N // 1000000000, in_words(B,BW), R is
  N mod 1000000000, (R == 0 -> atom_concat(BW,' billion',W) ; in_words(R,RW),
    (R =< 99999999 -> S = ' and' ; S = ,),
    concat_atom([BW,' billion',S,' ',RW],W)), !.

in_words(N,W) :- N =< 999999999999999, T is N // 1000000000000, in_words(T,TW), R is
  N mod 1000000000000, (R == 0 -> atom_concat(TW,' trillion',W) ; in_words(R,RW),
    (R =< 99999999999 -> S = ' and' ; S = ,),
    concat_atom([TW,' trillion',S,' ',RW],W)).
*/

in_words(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],W) ; in_words(R,RW),
    L is P // 10, (R < L -> S = ' and' ; S = ,),
    concat_atom([QW,' ',PN,S,' ',RW],W)).

unit_var(3,thir) :- !.
unit_var(5,fif) :- !.
unit_var(8,eigh) :- !.
unit_var(U,V) :- in_words(U,V).

ten_var(2,twen) :- !.
ten_var(4,for) :- !.
ten_var(U,V) :- unit_var(U,V).

nearest_power(N,1000,'thousand') :- N < 1000000, !.
nearest_power(N,1000000,'million') :- N < 1000000000, !.
nearest_power(N,1000000000,'billion') :- N < 1000000000000, !.
nearest_power(N,1000000000000,'trillion') :- N < 1000000000000000.