Römische Zahlen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
mback2k

Römische Zahlen

Beitrag von mback2k »

Kleiner Codeschnipsel, um dezimal Zahlen in römische Zahlen zu konvertieren und umgekehrt.

Code: Alles auswählen

Procedure.s RomDec(dec.l)
  Protected i.b, j.l, max.b, ind.w, num.w, chr.w, rom.s
  Restore RomNum : Read.b max
  For i = 1 To max
    Read.w ind : Read.w num : Read.w chr
    For j = 1 To Round((dec / num), #PB_Round_Down)
      rom + Chr(chr)
    Next : dec % num
  Next
  ProcedureReturn rom
EndProcedure

Procedure.l DecRom(rom.s)
  Protected i.b, j.w, max.b, ind.w, num.w, chr.w, dec.l
  Restore RomNum : Read.b max
  For i = 1 To max
    Read.w ind : Read.w num : Read.w chr
    For j = 0 To Len(rom)-1
      If PeekC(@rom+j) = chr : PokeC(@rom+j, ind)
        If j And PeekC(@rom+(j-1)) < ind : dec - num
        Else : dec + num : EndIf
      EndIf
    Next
  Next
  ProcedureReturn dec
EndProcedure

DataSection
  RomNum:
  Data.b  7     ;     Total
  Data.w  7,    1000, 'M'
  Data.w  6,    500,  'D'
  Data.w  5,    100,  'C'
  Data.w  4,    50,   'L'
  Data.w  3,    10,   'X'
  Data.w  2,    5,    'V'
  Data.w  1,    1,    'I'
EndDataSection

r.s = RomDec(1949)
d.l = DecRom(r)

Debug d
Debug r
Dieser Schnipsel benötigt PB4.30 oder neuer.
Zuletzt geändert von mback2k am 08.11.2008 20:09, insgesamt 1-mal geändert.
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Leider unkorrekte Werte, z.B. 4 sollte IV und nicht IIII ergeben.
Vielleicht neue römische Rechschreibung :mrgreen:

PS: Sollte vielleicht noch erwähnt werden, das dieser Code für PB4.30+ ist

Ansonsten ist die Umsetzung gut gemacht.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
mback2k

Beitrag von mback2k »

Oh, ich hab mich so darauf konzentiert größere Zahlen richtig darzustellen. ;)

Ich werd sehen, was ich noch verbessern kann. Hinweiß wegen PB4.30+ hinzugefügt.
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

> Ich werd sehen, was ich noch verbessern kann
Ich denke mal, da wirste eine andere Taktik nehmen müssen. Eine
Vergleichstabelle/Array zum Beispiel. Oder nur die 4-er und 9-er gesondert
behandeln (der Rest sollte wohl stimmen?).
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
mback2k

Beitrag von mback2k »

Ja, das Problem entsteht nur bei 4, 9, usw. Hmmm..
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7028
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Beitrag von STARGÅTE »

liegt daan das du keine Subtraktion eingebaut hast, sondern nur nach zeichen suchst:

Code: Alles auswählen

d.l = DecRom("IV") 
Debug d
er sieht halt I und V also 6, aber I steht ja vor V also muss es 4 sein ...
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
Josef Sniatecki
Beiträge: 657
Registriert: 02.06.2008 21:29
Kontaktdaten:

Beitrag von Josef Sniatecki »

Habe eine Lösung für Rom->Dec gefunden:

Code: Alles auswählen

Procedure RomDec(Rom.s)
  Protected *Char.Character,Index.l
  Protected Num.l,Level.l,ONum.l
  
  *Char=@Rom+Len(Rom)-1
  While *Char<>@Rom-1
    Select *Char\C
      Case 'I'
        ONum=1
      Case 'V'
        ONum=5
      Case 'X'
        ONum=10
      Case 'L'
        ONum=50
      Case 'C'
        ONum=100
      Case 'D'
        ONum=500
      Case 'M'
        ONum=1000
    EndSelect
    If Level<=ONum
      Level=ONum
      Num+ONum
    Else
      Num-ONum
    EndIf
    *Char-1
  Wend
  ProcedureReturn Num
EndProcedure
Ich lese einfach den string rückwärts aus und kontroliere ob der vorherige
Wert des Zeichens kleiner ist als das aktuelle zeichen.

Versucht einfach mal: "debug romdec("IV")".
PB 4.61 | Windows Vista - 32Bit
Homepage

"Wahrlich es ist nicht das Wissen, sondern das Lernen, nicht das Besitzen sondern das Erwerben, nicht das Dasein, sondern das Hinkommen, was den grössten Genuss gewährt." - Carl Friedrich Gauß
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

> Habe eine Lösung für Rom->Dec gefunden:
Okay, aber nur für nationale Anwendungen :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Andesdaf
Moderator
Beiträge: 2671
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag von Andesdaf »

nanu? wo ist denn der mback2k hin? :?
Edit: Sehe grade dass er sich wieder angemeldet hat... - Andesdaf
Win11 x64 | PB 6.20
Benutzeravatar
rolaf
Beiträge: 3843
Registriert: 10.03.2005 14:01

Beitrag von rolaf »

Andesdaf hat geschrieben:nanu? wo ist denn der mback2k hin? :?
Edit: Sehe grade dass er sich wieder angemeldet hat... - Andesdaf
Wurde bestimmt in einer Wow-Löschorgie zum Opfer.

Edit: W o w = Misst? Watt datt? :lol:
:::: WIN 10 :: PB 5.73 :: (x64) ::::
Antworten