Challenge 6

Patrick_35 · le 21 mai 2007

Bonsoir

Encore un challenge mais qui change des listes

Il s'agit de convertir un nombre en hexa et inversement

ex : (hex 448) -> "1C0"

ex : (dec "1C0") -> 448

ps : ne trichez pas en utilisant les fonctions vba ;)

@+

Bred · le 21 mai 2007

Salut...

ben comme je ne savais pas ce que c'étais l'"hexadécimal", merci Wikipéda !

Alors pour commencer, une version "jetée" pour dec :

(defun dec (nb)
 (setq lst-hexa (list
	 (cons "0" 0)
	 (cons "1" 1)
	 (cons "2" 2)
	 (cons "3" 3)
	 (cons "4" 4)
	 (cons "5" 5)
	 (cons "6" 6)
	 (cons "7" 7)
	 (cons "8" 8)
	 (cons "9" 9)
	 (cons "A" 10)
	 (cons "B" 11)
	 (cons "C" 12)
	 (cons "D" 13)
	 (cons "E" 14)
	 (cons "F" 15)))
 (repeat (setq i (strlen nb))
   (setq l (append (list (chr (vl-string-elt nb (setq i (1- i))))) l))
   )
 (setq total 0
i (strlen nb))
 (foreach n l
   (setq total (+ (* (cdr (assoc n lst-hexa))
	      (expt 16 (setq i (1- i)))) total))
   )
 )

J'ai l'impression que ça fonctionne ...

Pour "hex", je vais me coucher et je verrais un de ces soir ...

Bonne nuit.

ElpanovEvgeniy · le 22 mai 2007

(defun dec (s / i)
(setq i (- (strlen s) 0))
(apply
 (function +)
 (mapcar
  (function (lambda (x) (* (1- x) (lsh 16 (setq i (1- i))))))
  (VL-STRING->LIST
   (vl-string-translate
    "0123456789ABCDEF"
    "\001\002\003\004\005\006\007\010\t\n\013\014\r\016\017\020"
    (strcase s)
   ) ;_  vl-string-translate
  ) ;_  VL-STRING->LIST
 ) ;_  mapcar
) ;_  apply
)

Patrick_35 · le 22 mai 2007

Bien essayé ;) , mais

Bred

Cela ne fonctionne pas avec (dec "1c0")

ElpanovEvgeniy

Le résultat est faux avec (dec "448") retourne 512 alors que cela devrait être 1096

ps : tu peux te servir autrement de la fonction lsh

Juste pour vous guider, inutile de faire des boucles ou d'utiliser vl-*, regardez du coté des fonctions lisp rem et lsh

@+

zebulon_ · le 22 mai 2007

bonjour,

un peu d'algèbre...

Quand on est en base 10 et qu'on écrit un chiffre, par exemple 125, ce chiffre se décompose en :

5*10^0 + 2*10^1 + 1*10^2

De la même manière, quand on est en base 2 et qu'on écrit 1010, ce chiffe se décompose en :

0*2^0 + 1*2^1 + 0*2^2 + 1*2^3 (c'est à dire 0+2+0+8 = 10)

En base 16, c'est pareil. 1C0 se décompose en

0*16^0 + ©12*16^1 + 1*16^2 (c'est à dire 0+192+256=448)

Voilà qui devrait être une bonne piste pour la fonction (dec "1C0"). On pourrait même imaginer une fonction (dec "CHIFFRE" BASE).

Dans l'autre sens, il faut passer par les divisions entières en divisant par la base et en regardant ce qui reste.

Par exemple on veut transformer 118 décimal en binaire

118 div 2 = reste [surligneur]0[/surligneur] resultat 59

59 div 2 = reste [surligneur]1[/surligneur] resultat 29

29 div 2 = reste [surligneur]1[/surligneur] resultat 14

14 div 2 = reste [surligneur]0[/surligneur] resultat 7

7 div 2 = reste [surligneur]1[/surligneur] resultat 3

3 div 2 = reste [surligneur]1[/surligneur] resultat [surligneur]1[/surligneur]

et je m'arrête quand le dernier résultat est inférieur à la base. Puis je remonte la liste des restes à l'envers en commençant par le dernier résultat, donc :

1110110

Quand on est en base 16, c'est pareil. Faisons avec l'exemple décimal 448

448 div 16 = reste [surligneur]0[/surligneur] résultat 28

28 div 16 = reste 12 [surligneur]©[/surligneur] résultat [surligneur]1[/surligneur]

Je m'arrête parce que le dernier résultat est inférieur à la base et je remonte la liste des restes comme tout à l'heure en commençant par le dernier résultat

1C0

Voilà pour une fonction bin ou hex (ou ce qu'on voudra).

Amicalement

Zebulon_

[Edité le 22/5/2007 par zebulon_]

zebulon_ · le 22 mai 2007

Pour le dec, cela pourrait être quelque chose comme ça

 (defun dec (NB / LST ID I RES)
 (setq NB (strcase NB))
 (setq LST (reverse (vl-string->list nb)))
 (setq I 0)
 (setq RES 0)
 (repeat (length LST)
   (setq ID (nth I LST))
   (if (< ID 58)                ;; ascii du "9"
     (setq ID (- ID 48))        ;; ascii "0"=48 et 48-48=0
     (setq ID (- ID 55))        ;; ascii "A"=65 et 65-55=10
   )
   (setq RES (+ RES (* ID (expt 16 I))))
   (setq I (+ I 1))
 )
 RES
)

Amicalement

Zebulon_

zebulon_ · le 22 mai 2007

et le hex

(defun dec->hex (NB / RES)
 (if (< NB 10)
   (setq RES (+ NB 48))
   (setq RES (+ NB 55))
 )
 RES
)


(defun hex (NB / LST RESULTAT)
 (setq RESULTAT NB)
 (while (>= RESULTAT 16)
   (setq LST (cons (dec->hex (rem RESULTAT 16)) LST))
   (setq RESULTAT (fix (/ RESULTAT 16)))
 )
 (setq LST (cons (dec->hex RESULTAT) LST))
 (vl-list->string LST)
)

On va lasser le soin aux spécialistes d'écrire la même fonction en récursif. En plus, je n'ai pas utilisé la fonction lsh et j'ai utilisé des fonctions vl-*. C'est qu'il doit y avoir plus simple.

Amicalement

Zebulon_

[Edité le 22/5/2007 par zebulon_]

(gile) · le 22 mai 2007

Comme Bred, j'ai du aller me renseigner sur le système hexadécimal, dont j'avais peut-être vaguement entendu parlé , mais que je ne connaissais absolument pas.

Je donne déjà deux routines, pas très élégantes, mais qui semblent fonctionner, en espérant ariver à faire mieux et sans plagier celles de Patrick_35 qu'il me semble avoir vu par ici.

Décimal vers héxadécimal, argument : un entier

(defun d2h (nb / n l r)
 (setq n 0)
 (while (    (setq l  (cons
       (nth (/ (setq r (rem nb (expt 16 (setq n (1+ n)))))
	       (expt 16 (1- n))
	    )
	    '(48 49 50 51 52 53 54 55 56 57 65 66 67 68 69 70)
       )
       l
     )
  nb (- nb r)
   )
 )
 (vl-list->string l)
)

Héxadécimal vers décimal, argument : une chaine

(defun h2d (str / r n)
 (setq	str (vl-string->list (strcase str))
r   0
 )
 (repeat (setq n (length str))
   (setq r   (+ (* (vl-position
	      (car str)
	      '(48 49 50 51 52 53 54 55 56 57 65 66 67 68 69 70)
	    )
	    (expt 16 (setq n (1- n)))
	 )
	 r
      )
  str (cdr str)
   )
 )
 r
)

[Edité le 22/5/2007 par (gile)]

Bred · le 22 mai 2007

Bien essayé ;) , mais

Bred
Cela ne fonctionne pas avec (dec "1c0")

pfffffff... t'es pas sympa, mais je savais pas que la casse était importante !!!

donc voilà :

(defun dec (nb / L I LST-HEXA TOTAL)
 (setq lst-hexa (list
	 (cons "0" 0)
	 (cons "1" 1)
	 (cons "2" 2)
	 (cons "3" 3)
	 (cons "4" 4)
	 (cons "5" 5)
	 (cons "6" 6)
	 (cons "7" 7)
	 (cons "8" 8)
	 (cons "9" 9)
	 (cons "A" 10)
	 (cons "B" 11)
	 (cons "C" 12)
	 (cons "D" 13)
	 (cons "E" 14)
	 (cons "F" 15)))
 (repeat (setq i (strlen nb))
   (setq l (append (list (strcase (chr (vl-string-elt nb (setq i (1- i)))))) l))
   )
 (setq total 0
i (strlen nb))
 (foreach n l
   (setq total (+ (* (cdr (assoc n lst-hexa))
	      (expt 16 (setq i (1- i)))) total))
   )
 )

Patrick_35 · le 22 mai 2007

Eh bien bravo à vous tous et à Zebulon_ et avec une superbe explication :D

sans plagier celles de Patrick_35 qu'il me semble avoir vu par ici.

Exact, j'ai déjà publié la méthode decimal->hexa ;) , mais c'est bien de ne pas "tricher", sinon cela perd de son sel ;)

Je propose donc une autre méthode sur la base du calcul binaire avec la fonction lsh

L'hexa 1c0 peut se traduire comme ceci en binaire 000111000000

L'hexadécimal est calculé sur une base 15 ce qui donne en binaire 1111 ou en hexa F

Le premier caractère "1" convertit en base 15 donne 1, traduit en binaire 0001

Je décale mon premier code binaire vers la gauche de 4 bits, donc un (lsh 1 4), traduit en binaire 00010000

Le second caractère "C" convertit en base 15 donne 12, traduit en binaire 1100

En binaire 00010000+1100=00011100 se traduit en décimal 28

Je décale encore mon code binaire vers la gauche de 4 bits, donc un (lsh 28 4), traduit en binaire 000111000000

Le troisième caractère "0" convertit en base 15 donne 0, traduit en binaire 0

En binaire 000111000000+0000=000111000000 se traduit en décimal 448

Donc mon résultat final est 448

L'inverse est facile à faire

@+

(defun dec(n / r s)
 (if (= (type n) 'INT)
   (setq n (itoa n))
 )
 (setq r 0)
 (foreach s (vl-string->list (strcase n))
   (setq r (+
      (lsh r 4)
      (-
	s
	(if (<= s 57)
	  48
	  55
	)
      )
    )
   )
 )
)

(defun hex (n / r i)
 (setq r "")
 (while (> n 0)
   (setq i (rem n 16)
  n (lsh n -4)
  r (strcat
      (if (< i 10)
	(itoa i)
	(chr (+ 55 i ))
      )
      r
    )
   )
 )
)

Et avec les fonctions vba

(defun dec (nb / ui1 val)
 (vl-load-com)
 (setq ui1 (getvar "useri1"))
 (acad-push-dbmod)
 (if (= (type nb) 'INT)
   (setq nb (itoa nb))
 )
 (vla-eval
   (vlax-get-acad-object)
   (strcat
     "ThisDrawing.SetVariable \"USERI1\","
     "Val (\""
     (strcat "&H" nb)
     "\")"
   )
 )
 (setq val (getvar "useri1"))
 (setvar "useri1" ui1)
 (acad-pop-dbmod)
 val
)

(defun hex (nb / us1 val)
 (vl-load-com)
 (setq us1 (getvar "users1"))
 (acad-push-dbmod)
 (vla-eval
   (vlax-get-acad-object)
   (strcat
     "ThisDrawing.SetVariable \"USERS1\","
     "Hex (\""
     (itoa nb)
     "\")"
   )
 )
 (setq val (getvar "users1"))
 (setvar "users1" us1)
 (acad-pop-dbmod)
 val
)

ps : pas faire de boucle ou ne pas utiliser un vl-* :o , j'arrête l'eau car j'ai amélioré ma routine avec un vl-string->list en regardant vos messages

(gile) · le 22 mai 2007

Superbes routines Patrick,

Juste pour le FUN, dec récursif et sans vl-* (j'ai plus de mal avec hex)

(defun dec (str / n s)
 (setq n (strlen str))
 (if (zerop n)
   n
   (+ (* (if (numberp (read (setq s (substr str 1 1))))
    (atoi s)
    (- (ascii (strcase s)) 55)
  )
  (expt 16 (1- n))
      )
      (dec (substr str 2))
   )
 )
)

[Edité le 26/5/2007 par (gile)]

(gile) · le 22 mai 2007

Pour hex, je n'arrive pas à eviter de passer par une sous routine.

(defun hex (nb / sub)

 (defun sub (nb n / r d)
   (if	(= 0 (/ nb (expt 16 n)))
     ""
     (progn
(setq r (rem nb (expt 16 (1+ n))))
(strcat
  (sub (- nb r) (1+ n))
  (if (	    (itoa d)
    (chr (+ 55 d))
  )
)
     )
   )
 )

 (sub nb 0)
)

ElpanovEvgeniy · le 23 mai 2007

Bien essayé ;) , mais

Bred
Cela ne fonctionne pas avec (dec "1c0")

ElpanovEvgeniy
Le résultat est faux avec (dec "448") retourne 512 alors que cela devrait être 1096
ps : tu peux te servir autrement de la fonction lsh

Juste pour vous guider, inutile de faire des boucles ou d'utiliser vl-*, regardez du coté des fonctions lisp rem et lsh

@+

Merci!

Je suis corrigé...

(defun dec (s / i)
(setq i (1-(strlen s)))
(apply (function +)
       (mapcar
        (function (lambda (x) (* (1- x) (lsh 16 (* 4 (setq i (1- i)))))))
        (VL-STRING->LIST
         (vl-string-translate
          "0123456789ABCDEF"
          "\001\002\003\004\005\006\007\010\t\n\013\014\r\016\017\020"
          (strcase s)
         ) ;_ vl-string-translate
        ) ;_ VL-STRING->LIST
       ) ;_ mapcar
) ;_ apply
)

Connexion

Challenge 6

Messages recommandés

Patrick_35

Bred

ElpanovEvgeniy

Patrick_35

zebulon_

zebulon_

zebulon_

(gile)

Bred

Patrick_35

(gile)

(gile)

ElpanovEvgeniy

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante