×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

TRIM and REPEAT

TRIM and REPEAT

TRIM and REPEAT

(OP)
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 (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

RE: TRIM and REPEAT

Hhhhmmm, here is one solution:

CODE

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 winky smile

RE: TRIM and REPEAT

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.

RE: TRIM and REPEAT

(OP)
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

RE: TRIM and REPEAT

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.

RE: TRIM and REPEAT

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

RE: TRIM and REPEAT

(OP)
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

RE: TRIM and REPEAT

CODE

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 

RE: TRIM and REPEAT

(OP)
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

RE: TRIM and REPEAT

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'.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close