Challenge antique

[(gile)]

Salut,

 

Ça faisait longtemps, et une demande sur un autre forum m'a donné une idée.

 

Il s'agirait de faire une routine qui incrémente les chiffres romains :

 

(I+ "III") retourne "IV"

(I+ "XV") retourne "XVI"

(I+ "CXLIX") retourne "CL"

(I+ "MMMCMXCIX") retourne "MMMM"

 

Rappel :

I = 1

II = 2

III = 3

IV = 4

V = 5

VI = 6

VII = 7

VIII = 8

IX = 9

X = 10

L = 50

C = 100

D = 500

M = 1000

[bseb67]

Tentant comme challenge et cela peut donner des sous challenges :

- décrémenter un nombre

- additionner deux nombres (ou plus)

- soustraction entre deux nombres (ou plus)

- multiplication deux nombres (ou plus)

- division deux nombres (ou plus)

 

Mais avec le contexte en ce moment au bureau, je n'ai pas le temps :(

je suis blindé pour 2 mois encore...

[Tramber]

Ils sont fous ces romains :cool:

[Patrick_35]

Salut

 

Un challenge :D

 

; Traduire un nombre romain en décimal
(defun romdec(nb / pas pos tbl tot tro)
 (setq tbl (list (cons "I"    1)
	  (cons "IV"   4)
	  (cons "V"    5)
	  (cons "IX"   9)
	  (cons "X"   10)
	  (cons "XL"  40)
	  (cons "L"   50)
	  (cons "XC"  90)
	  (cons "C"  100)
	  (cons "CD" 400)
	  (cons "D"  500)
	  (cons "CM" 900)
	  (cons "M" 1000)
    )
 )
 (setq pos 1 pas 2 tot 0 nb (strcase nb))
 (while (and (setq txt (substr nb pos pas))
      (<= pos (strlen nb))
      (> pas 0)
 )
   (if (setq tro (assoc txt tbl))
     (setq tot (+ tot (cdr tro))
    pos (+ pos pas)
    pas 2
     )
     (setq pas (1- pas))
   )
 )
 tot
)

 

; Traduire un nombre décimal en romain
(defun decrom(nb / eng pas pos str tbl)
 (setq tbl (list (cons "I"    1)
	  (cons "IV"   4)
	  (cons "V"    5)
	  (cons "IX"   9)
	  (cons "X"   10)
	  (cons "XL"  40)
	  (cons "L"   50)
	  (cons "XC"  90)
	  (cons "C"  100)
	  (cons "CD" 400)
	  (cons "D"  500)
	  (cons "CM" 900)
	  (cons "M" 1000)
    )
 )
 (setq pas (1- (length tbl)) str "")
 (while (/= 0 pos)
   (setq pos (rem nb (cdr (setq eng (nth pas tbl)))))
   (repeat (/ nb (cdr eng))
     (setq str (strcat str (car eng)))
   )
   (setq nb pos pas (1- pas))
 )
 str
)

 

;Faire le calcul
(defun calrom(nb1 op nb2)
 (decrom ((eval op) (romdec nb1) (romdec nb2)))
)

 

(calrom "I" '+ "III") --> "IV"

(calrom "I" '+ "XV") --> "XVI"

(calrom "I" '+ "CXLIX") --> "CL"

(calrom "I" '+ "MMMCMXCIX") --> "MMMM"

(calrom "III" '* "CXLIX") --> "CDXLVII"

 

 

Pour le challenge de bseb67

 

(defun calrom(op nb)
 (decrom (apply op (mapcar 'romdec nb)))
)

 

(calrom '+ '("VI" "XV" "CXLIX")) --> "CLXX"

 

@+

 

[Edité le 14/4/2010 par Patrick_35]

[(gile)]

Salut,

 

Avec des fonctions de conversion chiffres arabes chiffres romains on pourra bien sûr faire facilement toute sorte d'opérations arithmétiques.

Au départ je pensais plutôt à une fonction spécifique d'incrémentation (c'était la demande sur ce forum). Celle que j'ai faite me satisfait à moitié (je pense qu'il est possible de faire plus élégant).

 

J'avais aussi fait deux fonctions de conversion assez semblables à celles de Patrick_35 :

 

(defun arabic2roman (n / m s)
 (setq s "")
 (mapcar '(lambda (a r)
     (setq m (/ n a)
	   n (rem n a)
     )
     (repeat m (setq s (strcat s r)))
   )
  '(1000 900 500 400 100 90 50 40 10 9 5 4 1)
  '("M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I")
 )
 s
)

(defun roman2arabic (s / n)
 (setq n 0)
 (mapcar '(lambda (a r)
     (while (= r (substr s 1 (strlen r)))
       (setq n (+ n a)
	     s (substr s (1+ (strlen r)))
       )
     )
   )
  '(1000 900 500 400 100 90 50 40 10 9 5 4 1)
  '("M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I")
 )
 n
)

[(gile)]

salut,

 

J'avais oublié ce challenge...

 

Voilà ma fonction d'incrémentation :

 

(defun I+ (s / foo)
 (defun foo (l1 l2)
   (cond
     ((= (car l1) (cadddr l1) (car l2))
      (if (cdr l2)
        (foo (cons (cadr l2) (cdddr l1)) l2)
        l1
      )
     )
     ((and (= (cadr l1) (cadr l2)) (= (caddr l1) (car l2)))
      (cons (cadr l2) (cdddr l1))
     )
     ((and (= (cadr l1) (caddr l2)) (= (caddr l1) (car l2)))
      (foo (cons (caddr l2) (cdddr l1)) (cddr l2))
     )
     ((and (= (car l1) (caddr l1) (cadr l2)) (= (cadr l1) (car l2)))
      (cons (caddr l2) (cons (car l2) (cdddr l1)))
     )
     (T l1)
   )
 )
 
 (vl-list->string
   (reverse
     (foo (cons 73 (reverse (vl-string->list s))) '(73 86 88 76 67 68 77))
   )
 )
)

[VDH-Bruno]

Bonsoir,

 

En tombant sur ce challenge un peu par hasard, l’idée m’a plu, et je mis suis attelé dans la soirée histoire de voir si il restait encore de la place pour d’autres propositions :

 

 

Pour les fonctions de conversions :

 

Décimal en Romain : Je n’ai rien pondu de neuf qui puisse détrôner les codes proposés précédemment.

 

Romain en Décimal: une variante qui devrait avoir sa place parmi celles de Patrick_35 et de (gile)

 

;; Conversion de chiffre Romain en Décimal
;; Exemple: (roman2arabic "MMXII") -> 2012
(defun roman2arabic (str / lst)
 (cond	((setq lst (assoc (substr str 1 2) '(("IV" . 4) ("IX" . 9) ("XL" . 40) ("XC" . 90) ("CD" . 400) ("CM" . 900))))
 (+ (cdr lst) (roman2arabic (substr str 3)))
)
((setq lst (assoc (substr str 1 1) '(("I" . 1) ("V" . 5) ("X" . 10) ("L" . 50) ("C" . 100) ("D" . 500) ("M" . 1000))))
 (+ (cdr lst) (roman2arabic (substr str 2)))
)
((= str "") 0)
 )
)

(Ps : Au passage sur cette version si on sort de la plage de caractère la fonction renvoie une erreur, plutôt qu'un résultat erroné)

 

 

Pour la fonction d'incrémentation :

 

Ma solution premiere

;; VDH-Bruno Explose un string (fonction symétrique à strcat)
;; Exemple: (explodestr "string") -> ("s" "t" "r" "i" "n" "g")
(defun explodestr (str)
 (if (/= str "")
   (cons (substr str 1 1) (explodestr (substr str 2)))))

(defun I+ (s / foo)

 (defun foo (n l r)
   (cond      
     ((and r (= n (car l) (cadr l) (caddr l)))
(if (= (cadddr l) (car r))
  (cons (cadr r) (cons n (cddddr l)))
         (cons (car r) (cddr l))
)       
     )
     ((and (/= (car l) (cadr l)) (= n (cadr l)))
      (foo (car l) (cddr l) (cddr r))
     )
     (T (cons n l))
   )
 )

 (apply 'strcat
 (reverse (foo "I"
	       (reverse (explodestr s))
	       '("V" "X" "L" "C" "D" "M")
	  )
 )
 )
)

 

 

Puis une seconde version sur le même algorithme, mais cette fois reprenant l’idée qui consiste à transformer la chaine en liste de caractère codé.

(defun I+ (s / foo)

 (defun foo (n l r)
   (cond      
     ((and r (= n (car l) (cadr l) (caddr l)))
(if (= (cadddr l) (car r))
  (cons (cadr r) (cons n (cddddr l)))
         (cons (car r) (cddr l))
)       
     )
     ((and (/= (car l) (cadr l)) (= n (cadr l)))
      (foo (car l) (cddr l) (cddr r))
     )
     (T (cons n l))
   )
 )

 (vl-list->string  
   (reverse  
     (foo 73 (reverse (vl-string->list s)) '(86 88 76 67 68 77)) 
   )
 )
)

 

A+

Modifié le 12 septembre 2012 par VDH-Bruno

[(gile)]

Salut,

 

C'est amusant, je me suis penché à nouveau sur les chiffres romains ces jours-ci mais en dotNET.

J'ai eu besoin d'implémenté une classe 'RomanNumerals' pour un outil d'incrémentation que j'ai soumis sur Exchange Apps Store.

[Patrick_35]

Salut

 

En regardant ta fonction explodestr, je me suis dis que l'on pouvait faire ceci

(defun explodestr (str)
 (mapcar 'chr (vl-string->list str))
)

 

@+

[VDH-Bruno]

Salut,

 

C'est amusant, je me suis penché à nouveau sur les chiffres romains ces jours-ci..

A cette occasion j’ai également découvert que la règle soustractive IV, IX etc… N’a pas toujours été la norme, cela c’est (entre autre) également noté IIII, VIIII etc…

 

D’ailleurs Cet usage fut repris en horlogerie, où le chiffre 4 s'écrit IIII, essentiellement pour des raisons de lisibilité sur un cadran rond, surtout quand les bières (gravures chiffrées) y sont inclinées.

 

Cela m’a beaucoup amusé de porter un autre regard sur le quadrant de mon horloge :(rires forts): , dire qu’il m’a fallu 40 ans et ce challenge pour observer et réfléchir à ce détail… :blink:

 

Amicalement

 

(Ps : Patrick_35 bien vu pour ta ligne de code, je dois avouer que je n’avais pas poussé plus loin la généralisation de l’usage de vl-string->list, merci car explodestr est une routine appelé dans d’autres fonctions bibliothèques).