Nombres romains

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
ATHOW
Messages : 226
Inscription : mer. 29/déc./2004 16:54

Nombres romains

Message par ATHOW »

Salut à tous, j'ai eu besoin de coder deux procédures pour transformer un nombre en nombre romain et vice versa. Je vous les fait donc partager : (marche pour PB 3.94 comme PB 4.00)

Code : Tout sélectionner

Procedure.w nr_valeurChiffreRomain(l.s)
  l=UCase(l)
  Select l
    Case "I"
      ProcedureReturn 1
    Case "V"
      ProcedureReturn 5
    Case "X"
      ProcedureReturn 10
    Case "L"
      ProcedureReturn 50
    Case "C"
      ProcedureReturn 100
    Case "D"
      ProcedureReturn 500
    Case "M"
      ProcedureReturn 1000
    Default
      ProcedureReturn 0
  EndSelect      
EndProcedure

Procedure.w nr_valeurNombreRomain(nr.s)
  If nr = ""
    ProcedureReturn 0
  Else
    res.w = 0
    If Len(nr) = 1
      ProcedureReturn nr_valeurChiffreRomain(nr)
    Else
      res = nr_valeurChiffreRomain(Left(nr, 1))

      If res < nr_valeurChiffreRomain(Mid(nr, 2, 1))
        res = -res
      EndIf
      ProcedureReturn res + nr_valeurNombreRomain(Right(nr,Len(nr)-1))
    EndIf
  EndIf
EndProcedure
  
Procedure.s nr_toNombreRomain(n.w)
  res.s = ""
  tmp.w = n
  While tmp >= 1000
    res + "M"
    tmp - 1000
  Wend
  If tmp >= 900
    res + "CM"
    tmp - 900
  EndIf
  If tmp >= 800
    res + "DCCC"
    tmp - 800
  EndIf
  If tmp >= 700
    res + "DCC"
    tmp - 700
  EndIf
  If tmp >= 600
    res + "DC"
    tmp - 600
  EndIf
  If tmp >= 500
    res + "D"
    tmp - 500
  EndIf
  If tmp >= 400
    res + "CD"
    tmp - 400
  EndIf
  If tmp >= 300
    res + "CCC"
    tmp - 300
  EndIf
  If tmp >= 200
    res + "CC"
    tmp - 200
  EndIf
  If tmp >= 100
    res + "C"
    tmp - 100
  EndIf
  If tmp >= 90
    res + "XC"
    tmp - 90
  EndIf
  If tmp >= 80
    res + "LXXX"
    tmp - 80
  EndIf
  If tmp >= 70
    res + "LXX"
    tmp - 70
  EndIf
  If tmp >= 60
    res + "LX"
    tmp - 60
  EndIf
  If tmp >= 50
    res + "L"
    tmp - 50
  EndIf
  If tmp >= 40
    res + "XL"
    tmp - 40
  EndIf
  If tmp >= 30
    res + "XXX"
    tmp - 30
  EndIf
  If tmp >= 20
    res + "XX"
    tmp - 20
  EndIf
  If tmp >= 10
    res + "X"
    tmp - 10
  EndIf
  If tmp = 9
    res + "IX"
  ElseIf tmp = 8
    res + "VIII"
  ElseIf tmp = 7
    res + "VII"
  ElseIf tmp = 6
    res + "VI"
  ElseIf tmp = 5
    res + "V"
  ElseIf tmp = 4
    res + "IV"
  ElseIf tmp = 3
    res + "III"
  ElseIf tmp = 2
    res + "II"
  ElseIf tmp = 1
    res + "I"
  EndIf    
  ProcedureReturn res
EndProcedure

For i.w=1 To 4000
  nr.s = nr_toNombreRomain(i)
  Debug  Str(i) + " -> " + nr + " -> " + Str(nr_valeurNombreRomain(nr))
Next i
J'imagine que ce ne sera pas utile à beaucoup, mais qui sait....

Bonne soirée !
Haut
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

j'avais publié un algo que j'avais étudié il y a quelque temps.

Code : Tout sélectionner

Procedure.s StrR(number.l) ; Conversion d'un nombre entier en chiffres romains [0<n<10000] 
  
  Protected i.l, value.l, result.s
  
  For i = 1 To 13 
    value = Val(StringField("1000,900,500,400,100,90,50,40,10,9,5,4,1", i, ",")) 
    While number >= value
      result + StringField("M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I", i, ",") 
      number - value
    Wend 
  Next 
  
  ProcedureReturn result 
  
EndProcedure 

For i = 1 To 4000
  Debug Str(i) + " = " + StrR(i) 
Next
Image
Haut
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

Travaux de romains :)
Est beau ce qui plaît sans concept :)
Speedy Galerie
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

Flype a écrit :j'avais publié un algo que j'avais étudié il y a quelque temps.
c'est la ou l'on voit l'experience acquise par un ancien "purebasicien" :D

faire en 14 lignes de code ce qu'un "debutant" fera en + de 100 lignes :D
Haut
ATHOW
Messages : 226
Inscription : mer. 29/déc./2004 16:54

Message par ATHOW »

@Flype : Bonne idée les StringField !
@Dobro : tu triches, moi j'ai fait l'algo inverse aussi :)
Et sans vouloir passer pour ce que je ne suis pas, la complexité d'un algo n'est pas proportionnel à sa taille... ma procédure "nr_toNombreRomain(n.w)" est longue, mais de complexité en temps constant pour un nombre <2000.
Enfin, dans tous les cas, j'apprends beaucoup avec vous en Pure, c'est cool !
Haut
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

c'est vrai. ta procedure marche. c'est bien le principal.
la mienne je l'avais étudié en cours au CNAM ya longtemps.
elle m'a toujours plu cette fonction, et transcrite en pure elle me plait encore plus. :D
la complexité d'un algo n'est pas proportionnel à sa taille
en revanche la simplicité d'un algo est souvent proportionnelle a sa taille.
souvent quand on doit mettre plein de If/Endif, c'est qu'on doit passer à coté d'un truc.
bonne idée les stringfield
ouai j'aime bien.

çà :
StringField("1000,900,500,400,100,90,50,40,10,9,5,4,1", i, ",")

c'est une manière un peu flemmarde, quoiqu'élégante mais surtout économique en nombre de lignes pour la même chose que :

Dim RomValues.l(13)
RomValues(0) = 1000
RomValues(1) = 900
RomValues(2) = 500
etc...

le tableau est tout de meme bcp plus rapide.
Image
Haut
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

le "champs d'introduction de données d'un StringField
StringField("1000,900,500,400,100,90,50,40,10,9,5,4,1", i, ",")
est limité à combien de caractères?
Est beau ce qui plaît sans concept :)
Speedy Galerie
Haut
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

j'ai pas trop compris (?)

si tu parles du séparateur, il doit faire 1 seul caractère.
pour les autres arguments, il n'y a pas de limite en principe.
Image
Haut
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

Ce qu'on met entre les parenthèses, il n'y a pas une limite au nombre de caractères? (256 - le nombres de caractères de StringField+2, par exemple)?
J'ai pas regardé la doc :roll:
Est beau ce qui plaît sans concept :)
Speedy Galerie
Haut
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

non pas de limite en principe.

j'ai un bcp optimisé le code, c'est très rapide...

Code : Tout sélectionner

Global Dim RC.l($FFFF), Dim RL.l(12), Dim RS.s(12)

RC('I') = 0001
RC('V') = 0005
RC('X') = 0010
RC('L') = 0050
RC('C') = 0100
RC('D') = 0500
RC('M') = 1000

RL(00) = 1000
RL(01) = 0900
RL(02) = 0500
RL(03) = 0400
RL(04) = 0100
RL(05) = 0090
RL(06) = 0050
RL(07) = 0040
RL(08) = 0010
RL(09) = 0009
RL(10) = 0005
RL(11) = 0004
RL(12) = 0001

RS(00) = "M" 
RS(01) = "CM"
RS(02) = "D" 
RS(03) = "CD"
RS(04) = "C" 
RS(05) = "XC"
RS(06) = "L" 
RS(07) = "XL"
RS(08) = "X" 
RS(09) = "IX"
RS(10) = "V" 
RS(11) = "IV"
RS(12) = "I" 

Procedure.s StrR(number.l) ; Conversion d'un nombre entier en nombre romain. [0<n<10000] 
  
  Protected i.l, result.s
  
  For i = 0 To 12
    While number >= RL(i)
      number - RL(i)
      result + RS(i)
    Wend 
  Next 
  
  ProcedureReturn result 
  
EndProcedure 

Procedure.l ValR(number.s) ; Conversion d'un nombre romain en nombre entier. [I<n<MMMM] 
  
  Protected oldvalue.l, result.l
  Protected *num.Character = @number + Len(number) * SizeOf(character) - SizeOf(Character)
  
  While *num\c
    If oldvalue > RC(*num\c)
      result - RC(*num\c)
    Else
      result + RC(*num\c)
    EndIf
    oldvalue = RC(*num\c)
    *num - SizeOf(Character)
  Wend
  
  ProcedureReturn result 
  
EndProcedure 

z = ElapsedMilliseconds()

For j.l = 0 To 50
  For i.w = 1 To 4000
    TEST$ = Str(i) + " = " + StrR(i) + " = " + Str(ValR(StrR(i)))
    Debug TEST$
  Next i
Next j

MessageRequester("", Str(ElapsedMilliseconds()-z))
Image
Haut
Répondre

Revenir à « Trucs et astuces »