Benutzer:Schwalbe/Konvertierung römischer Zahlen

Visual Basic

Arabische in römische Zahlen

Der folgende Code implementiert die Subtraktionsregel in eine Visual Basic-Funktion:

Function Arab2Roman(ByVal intArab As Integer) As String

    If intArab < 1 Or intArab > 4999 Then Arab2Roman = "<Range?>": Exit Function
    Arab2Roman = Arab2Roman & String(intArab \ 1000, "M"): intArab = intArab Mod 1000
    Arab2Roman = Arab2Roman & IIf(intArab \ 900 > 0, "CM", ""): intArab = intArab Mod 900
    Arab2Roman = Arab2Roman & String(intArab \ 500, "D"): intArab = intArab Mod 500
    Arab2Roman = Arab2Roman & IIf(intArab \ 400 > 0, "CD", ""): intArab = intArab Mod 400
    Arab2Roman = Arab2Roman & String(intArab \ 100, "C"): intArab = intArab Mod 100
    Arab2Roman = Arab2Roman & IIf(intArab \ 90 > 0, "XC", ""): intArab = intArab Mod 90
    Arab2Roman = Arab2Roman & String(intArab \ 50, "L"): intArab = intArab Mod 50
    Arab2Roman = Arab2Roman & IIf(intArab \ 40 > 0, "XL", ""): intArab = intArab Mod 40
    Arab2Roman = Arab2Roman & String(intArab \ 10, "X"): intArab = intArab Mod 10
    Arab2Roman = Arab2Roman & IIf(intArab \ 9 > 0, "IX", ""): intArab = intArab Mod 9
    Arab2Roman = Arab2Roman & String(intArab \ 5, "V"): intArab = intArab Mod 5
    Arab2Roman = Arab2Roman & IIf(intArab \ 4 > 0, "IV", ""): intArab = intArab Mod 4
    Arab2Roman = Arab2Roman & String(intArab, "I")
    
End Function

Römische in arabische Zahlen

Der folgende Code rechnet die römischen Ziffern zurück in Dezimalzahlen:

Private Function Roman2Arab(ByVal sRomLettersInput As String) As Long
Dim i       As Integer

Dim lTmpVal As Long     'berechneter Wert, temporär
Dim lDecVal As Long     'Endgültiger zurückgerechneter Wert
Dim sTmp()  As String   'temp. Array

Dim colDECValue As Collection 'Dictionary für die Werte der römischen Ziffern

'instanzieren
Set colDECValue = New Collection

'Werte befüllen
With colDECValue
    .Add 1000, "M"
    .Add 500, "D"
    .Add 100, "C"
    .Add 50, "L"
    .Add 10, "X"
    .Add 5, "V"
    .Add 1, "I"
End With

ReDim sTmp(Len(sRomLettersInput) - 1)

For i = 1 To Len(sRomLettersInput)
    'jedes Zeichen auslesen und in Array ablegen
    sTmp(i - 1) = Mid$(sRomLettersInput, i, 1)
Next i

For i = 0 To UBound(sTmp)
    'solange Ubound nicht erreicht
    If (i < UBound(sTmp)) Then
        'liegt eine Subtraktionsregel vor?
        If colDECValue(sTmp(i)) < colDECValue(sTmp(i + 1)) Then
            lTmpVal = colDECValue(sTmp(i + 1)) - colDECValue(sTmp(i))
            i = i + 1 'nächsten Wert auslassen aus Berechnung
        Else
            lTmpVal = colDECValue(sTmp(i))
        End If
    Else
        lTmpVal = colDECValue(sTmp(i))
    End If
    
    lDecVal = lDecVal + lTmpVal
Next i
Roman2Arab = lDecVal

End Function

x86-Assembler

Für Fortgeschrittene gibt es dasselbe auch in Assembler.

Arabische in römische Zahlen

Benutzt keine Subtraktionsregel und den fiktiven Buchstaben "N" für Null. Auf den Wertebereich von WORD begrenzt. Input: value:DWORD, str_ptr:DWORD; stdcall

a2r:
mov eax,DWORD PTR [esp+8]
cmp DWORD PTR [esp+4],0
jnz @F
mov WORD PTR [eax],004eh ; nullae
retn 8
@@:
test DWORD PTR [esp+4],0FFFF0000h
jz @F
mov WORD PTR [eax],003fh ; word values only
retn 8
@@:
push ebp
mov ebp,eax
mov eax,DWORD PTR [esp+8]
mov ecx,1000
xor edx,edx
div ecx
or eax,eax
jz nothousands
@@:
mov BYTE PTR [ebp],'M'
add ebp,1
sub eax,1
jnz @B
nothousands:
mov eax,edx
mov ecx,500
xor edx,edx
div ecx
or eax,eax
jz no5hundreds
@@:
mov BYTE PTR [ebp],'D'
add ebp,1
sub eax,1
jnz @B
no5hundreds:
mov eax,edx
mov ecx,100
xor edx,edx
div ecx
or eax,eax
jz nohundreds
@@:
mov BYTE PTR [ebp],'C'
add ebp,1
sub eax,1
jnz @B
nohundreds:
mov eax,edx
db 0d4h,50 ; aam 50
or ah,ah
jz nofifties
@@:
mov BYTE PTR [ebp],'L'
add ebp,1
sub ah,1
jnz @B
nofifties:
db 0d4h,10
or ah,ah
jz notens
@@:
mov BYTE PTR [ebp],'X'
add ebp,1
sub ah,1
jnz @B
notens:
db 0d4h,5
or ah,ah
jz nofives
@@:
mov BYTE PTR [ebp],'V'
add ebp,1
sub ah,1
jnz @B
nofives:
or al,al
jz noones
@@:
mov BYTE PTR [ebp],'I'
add ebp,1
sub al,1
jnz @B
noones:
mov BYTE PTR [ebp],0
pop ebp
retn 8

Römische in arabische Zahlen

Right-to-left heuristic for subtractive notation. Input: str_ptr:DWORD

.data

r2a_trans1 dw 100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10

.code

r2a:
mov edx,DWORD PTR [esp+4]
xor eax,eax
cmp BYTE PTR [edx],'N'
jnz @F
retn 4
@@:
push ebp
xor ebp,ebp
xor ecx,ecx
push ebx
mov ebx,offset r2a_trans1
jmp j
@@:
add edx,1
j:
cmp BYTE PTR [edx],0
jne @B
@@:
cmp edx,DWORD PTR [esp+12]
je @F
sub edx,1
mov al,BYTE PTR [edx]
cmp al,99
js capital
sub al,32
capital:
sub al,67
mov ax,[ebx+eax*2]
cmp eax,ebp
je next1
jg next2
sub ecx,eax
jmp next
next2:
mov ebp,eax
next1:
add ecx,eax
next:
xor ah,ah
jmp @B
@@:
pop ebx
pop ebp
mov eax,ecx
retn 4

Kategorie:Algorithmus Kategorie:Quellcode