Roman numerals

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Berkeley
Posts: 73
Joined: Jun 08, 2024 15:03

Roman numerals

Post by Berkeley »

Me was boring.

So I wrote two functions creating and "reading"(parsing) Roman numerals:

Code: Select all

FUNCTION ROMANNUMERAL(BYVAL number AS INTEGER) AS STRING
  DIM AS STRING result
  DIM AS INTEGER i

  IF number=0 THEN RETURN "0"
  IF number<0 THEN result="-" ELSE result=""

  number=ABS(number)

  IF number>999 THEN
    i=INT(number/1000)
    result+=STRING(i, "M")
    number-=i*1000
  ENDIF
  IF number>899 THEN
    result+="CM" ' 900
    number-=900
  ENDIF
  
  IF number>499 THEN 
    result+="D" ' 500
    number-=500
  ENDIF
  IF number>399 THEN
    result+="CD" ' 400
    number-=400
  ENDIF
  
  IF number>99 THEN
    i=INT(number/100)
    result+=STRING(i, "C")
    number-=i*100
  ENDIF
  IF number>89 THEN
    result+="XC" ' 90
    number-=90
  ENDIF
  
  IF number>49 THEN
    result+="L" ' 50
    number-=50
  ENDIF
  IF number>39 THEN
    result+="XL" '40
  ENDIF
  
  IF number>9 THEN
    i=INT(number/10)
    result+=STRING(i, "X")
    number-=i*10  
  ENDIF
  IF number>8 THEN
    result+="IX" ' 9
    number-=9
  ENDIF
  
  IF number>4 THEN
    result+="V" ' 5
    number-=5
  ENDIF
  IF number>3 THEN
    result+="IV" ' 4
    number-=4
  ENDIF
  
  IF number THEN ' (number should now only reach from 0 to 3)
    result+=STRING(number, "I")
  ENDIF

  RETURN result
END FUNCTION

FUNCTION ROMANNUMERALVALUE(BYVAL numstring AS STRING) AS INTEGER
  DIM AS INTEGER i, result
  DIM AS BOOLEAN negative
  
  IF numstring="" THEN RETURN 0 ' empty string
  IF MID(numstring, 1, 1)="0" THEN RETURN 0 ' starting with '0' => 0 or illegal

  ' let's play it safe...
  numstring=UCASE(numstring)
  
  i=1
  negative=FALSE

  IF MID(numstring, 1, 1)="-" THEN ' negative number
    negative=TRUE
    i+=1
  ENDIF
  
  WHILE MID(numstring, i, 1)="M"
    result+=1000
    i+=1
  WEND
  IF MID(numstring, i, 2)="CM" THEN
    result+=900
    i+=2
  ENDIF
  
  IF MID(numstring, i, 1)="D" THEN
    result+=500
    i+=1
  ENDIF
  IF MID(numstring, i, 2)="CD" THEN
    result+=400
    i+=2
  ENDIF
  
  WHILE MID(numstring, i, 1)="C"
    result+=100
    i+=1
  WEND  
  IF MID(numstring, i, 2)="XC" THEN
    result+=90
    i+=2
  ENDIF
  
  IF MID(numstring, i, 1)="L" THEN
    result+=50
    i+=1
  ENDIF
  IF MID(numstring, i, 2)="XL" THEN
    result+=40
    i+=2
  ENDIF

  WHILE MID(numstring, i, 1)="X"
    result+=10
    i+=1
  WEND
  IF MID(numstring, i, 2)="IX" THEN
    result+=9
    i+=2
  ENDIF
  
  IF MID(numstring, i, 1)="V" THEN
    result+=5
    i+=1
  ENDIF
  IF MID(numstring, i, 2)="IV" THEN
    result+=4
    i+=2
  ENDIF
  
  WHILE MID(numstring, i, 1)="I"
    result+=1
    i+=1
  WEND
  
  IF negative THEN result*=-1
  
  RETURN result
END FUNCTION
They create and expect correct Roman numerals as far as I know. Except: normally there is no zero or even negative values. But those are/were used in some scientific contexts like oxidation states.

The sourcecode is nice to read and educational, although you might notice that there's a pattern you may use to write it in a loop. But it ain't as easy as it looks like: "V", "L" and "D" are not treated the same way as "I", "X", "C" and "M". And the "smarter" version would be only hard to read with not much gain.
Post Reply