Roman numerals/Encode: Difference between revisions

Content deleted Content added
Underscore (talk | contribs)
m →‎{{header|Perl 6}}: Forced inputs to &roman to be positive.
more concise Fortran program
Line 523:
=={{header|Fortran}}==
{{works with|Fortran|90+}}
<lang fortran>program MODULE Romanroman_numerals
 
IMPLICIT NONE
implicit none
CONTAINS
 
FUNCTION numerals(number)
write (*, '(a)') roman (2009)
CHARACTER(15) :: numerals
write (*, '(a)') roman (1666)
CHARACTER(4) :: thousand_str, hundred_str, ten_str, unit_str
write (*, '(a)') roman (3888)
INTEGER :: number, thousands, hundreds, tens
 
contains
 
function roman (n) result (r)
 
implicit none
integer, intent (in) :: n
integer, parameter :: d_max = 13
integer :: d
integer :: m
integer :: m_div
character (32) :: r
integer, dimension (d_max), parameter :: d_dec = &
& (/1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1/)
character (32), dimension (d_max), parameter :: d_rom = &
& (/'M ', 'CM', 'D ', 'CD', 'C ', 'XC', 'L ', 'XL', 'X ', 'IX', 'V ', 'IV', 'I '/)
 
r = ''
m = n
do d = 1, d_max
m_div = m / d_dec (d)
r = trim (r) // repeat (trim (d_rom (d)), m_div)
m = m - d_dec (d) * m_div
end do
 
end function roman
 
end program roman_numerals
</lang>
Output:
thousands = number / 1000
MMIX
SELECT CASE (thousands)
MDCLXVI
CASE(0)
MMMDCCCLXXXVIII
thousand_str = ""
CASE(1:4)
thousand_str = REPEAT(STRING="M", NCOPIES=thousands)
END SELECT
number = MOD(number, 1000)
hundreds = number / 100
SELECT CASE (hundreds)
CASE(0)
hundred_str = ""
CASE(1:3)
hundred_str = REPEAT(STRING="C", NCOPIES=hundreds)
CASE(4)
hundred_str = "CD"
CASE(5)
hundred_str = "D"
CASE(6:8)
hundred_str = "D"//REPEAT(STRING="C", NCOPIES=hundreds-5)
CASE(9)
hundred_str = "CM"
END SELECT
number = MOD(number, 100)
tens = number / 10
SELECT CASE (tens)
CASE(0)
ten_str = ""
CASE(1:3)
ten_str = REPEAT(STRING="X", NCOPIES=tens)
CASE(4)
ten_str = "XL"
CASE(5)
ten_str = "L"
CASE(6:8)
ten_str = "L"//REPEAT(STRING="X", NCOPIES=tens-5)
CASE(9)
ten_str = "XC"
END SELECT
number = MOD(number, 10)
SELECT CASE (number)
CASE(0)
unit_str = ""
CASE(1:3)
unit_str = REPEAT(STRING="I", NCOPIES=number)
CASE(4)
unit_str = "IV"
CASE(5)
unit_str = "V"
CASE(6:8)
unit_str = "V"//REPEAT(STRING="I", NCOPIES=number-5)
CASE(9)
unit_str = "IX"
END SELECT
numerals = TRIM(thousand_str)//TRIM(hundred_str)//TRIM(ten_str)//TRIM(unit_str)
END FUNCTION
END MODULE
PROGRAM ROMAN_TEST
USE Roman
WRITE(*,*) numerals(2008)
WRITE(*,*) numerals(1666)
WRITE(*,*) numerals(3888)
END PROGRAM ROMAN_TEST</lang>
Output
MMVIII
MDCLXVI
MMMDCCCLXXXVIII
 
=={{header|Haskell}}==