TRIM and REPEAT 1

[j0zn]

Hi everyone! I'd like to know if someone cold help me to find a way to substitute "trim" and "repeat" in the following program:


program roman_numerals

implicit none

write (*, '(a)') roman (2009)
write (*, '(a)') roman (1666)
write (*, '(a)') roman (3888)

contains

function roman 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

 

[salgerman]

Hhhhmmm, here is one solution:

program roman_numerals
    implicit none

    write (*, '(a)') roman (2009)
    write (*, '(a)') roman (1666)
    write (*, '(a)') roman (3888)

contains

function roman (n) result (r)
    implicit none
    integer, intent (in) :: n
    integer, parameter :: d_max = 13
    integer :: d, j, k, m, 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 (9), dimension (d_max), parameter :: d_rom = &
      (/'MMMMMMMMM', 'CM       ', 'D        ', 'CD       ', &
        'CCC      ', 'XC       ', 'L        ', 'XL       ', &
        'XXX      ', 'IX       ', 'V        ', 'IV       ', &
        'III      '/)
        
    m = n
    r='' ; k=0
    do d = 1, d_max
        m_div = m/d_dec(d)
        if (d_dec(d)==1000 .or. d_dec(d)==100 .or. d_dec(d)==10 .or. d_dec(d)==1) then
            r(k+1:k+m_div) = d_rom(d)(1:m_div)
            k=k+m_div
        else if ( m_div > 0 ) then
            j = 2
            if (d_dec(d)==500 .or. d_dec(d)==50 .or. d_dec(d)==5) j = 1
            r(k+1:k+j) = d_rom(d)(1:j)
            k=k+j
        end if        
        m = m - d_dec(d)*m_div        
    end do
end function roman

end program roman_numerals

If definitely does not look as elegant as yours but it does not make use of trim or repeat ;-)

 

[salgerman]

Oh, I guess I assumed you are not interested in very large numbers but only years up to current date and/or no more than 7000 years into the future...otherwise, we would need another loop and possible dynamic allocation of the resulting character.

 

[j0zn]

Thank you so much! What you did is amazing but I'd like to know what really you did bellow:

if (d_dec(d)==1000 .or. d_dec(d)==100 .or. d_dec(d)==10 .or. d_dec(d)==1) then
r(k+1:k+m_div) = d_rom(d)(1:m_div)
k=k+m_div
else if ( m_div > 0 ) then
j = 2
if (d_dec(d)==500 .or. d_dec(d)==50 .or. d_dec(d)==5) j = 1
r(k+1:k+j) = d_rom(d)(1:j)
k=k+j
end if

 

[salgerman]

First, recall that a character string behaves like an array:

character(30):: str
str='AB with trailing blanks '

'AB' = str(1:2)
'AB with trailing blanks' = trim(str)
'AB with trailing blanks' = str(1:23)

See? I don't need trim...for as long as I know how many character I am interested in.

So a character string pretty much behaves like an array; so, when you defined d_rom as an array of character strings, you basically have an array of arrays...to that end, you do not need to copy the entire i-th string every time, you can slice it. For example, you do not have to get the entire d_rom(d) with all trailing blank spaces and trim every time; if you know you only need the first 1 or 2 characters, you can simply get those with d_rom(d)(1:1) or d_rom(d)(1:2), respectively.

Once you know that, the rest is fairly simple (after a couple of observations).

Refer back to my intialization of d_rom...can you see a pattern?...

Aside from the years that start with '1' (1000,100,10,1), it is clear that years that start with '5' (500,50,5) are 1-letter numerals and the 'rest' are 2-letter numerals.

So, once you know you are NOT dealing with years '1*', you fall into the 'else' caluse; and, once in there, you should plan to copy two characters (j=2) out of the d-th d_rom() string, but if you find you are dealing with a '5*' year, then you only want to copy one character (j=1) out of the string: d_rom(d)(1:j). By the way, for these numerals, m/d_dec(d) is always at most 1, so you either need to copy it once or not copy at all...so, no need for a REPEAT, here.

Now, back to the 'if' clause...why do I give special treatment to the years starting with '1'? Because even though those years are also 1-letter numerals, depending on the year being converted, the division m/d_dec(d) can yield m_div>1 and, so, I would need the 1-letter numeral repeated as many as m_div times...is this clear? That's why I defined these strings as already a repetition of the 1-letter numerals to spare myself a REPEAT later on.

In other words, when you do m/d_dec(d) the answer is at most 1 for most numerals except for years 1000, 100, 10, 1. Additionally, the answer is at most 3 for 100, 10, 1...and that's why those strings need not be longer. Finally, the thousands can be as large as the number to be converted but I don't know roman numerals and don't know how to express something like 74,000 or 153,000...is it just a bunch of M's? You initial code does not indicate so.

Hope this is clear.

 

[j0zn]

Thanks salgerman! You explanation was very usefull for this problem! Congratulation!

 

[j0zn]

Is possible in fortran use this code below without IFs, using only something like math? I am trying to do this and my program show some erro.

m = n
r='' ; k=0
do d = 1, d_max
m_div = m/d_dec(d)
if (d_dec(d)==1000 .or. d_dec(d)==100 .or. d_dec(d)==10 .or. d_dec(d)==1) then
r(k+1:k+m_div) = d_rom(d)(1:m_div)
k=k+m_div
else if ( m_div > 0 ) then
j = 2
if (d_dec(d)==500 .or. d_dec(d)==50 .or. d_dec(d)==5) j = 1
r(k+1:k+j) = d_rom(d)(1:j)
k=k+j
end if
m = m - d_dec(d)*m_div
end do

 

[salgerman]

    m = n 
    r='' ; k=0 ; d = 0    
    
    d = d+1 ; m_div = m/d_dec(d) ; m = m - d_dec(d)*m_div        
    r(k+1:k+m_div) = d_rom(d)(1:m_div)
    k = k+m_div
    do i = 1,3    
        d = d+1 ; m_div = m/d_dec(d) ; m = m - d_dec(d)*m_div ; j = 2*m_div
        r(k+1:k+j) = d_rom(d)(1:j)
        k = k+j
        d = d+1 ; m_div = m/d_dec(d) ; m = m - d_dec(d)*m_div ; j = 1*m_div  
        r(k+1:k+j) = d_rom(d)(1:j)
        k = k+j
        d = d+1 ; m_div = m/d_dec(d) ; m = m - d_dec(d)*m_div ; j = 2*m_div
        r(k+1:k+j) = d_rom(d)(1:j)
        k = k+j
        d = d+1 ; m_div = m/d_dec(d) ; m = m - d_dec(d)*m_div        
        r(k+1:k+m_div) = d_rom(d)(1:m_div)
        k = k+m_div
    end do

 

[j0zn]

I am trying understand why the loop is
do i=1,3
...
end do


Why we have to limit it to this interval?
Thank you in advance

 

[salgerman]

Pick a number and convert it to roman numeral "by hand" but following the program...pay attention to what happens for every value of 'i' and 'd'.