Topic: -= {Challenge} =- convert an hexadecimal into a decimal

[ElpanovEvgeniy]

My program also works with any number of dimensions, without limitation, as BigInterger...
The same, I look to you. 

Code: [Select]

(setq s "ffffffffffffffffffffffffffffffffffffffffffffffffff")
(strlen s) ;=>> 50
(hex2dec "ffffffffffffffffffffffffffffffffffffffffffffffffff")
;=>> "1606938044258990275541962092341162602522202993782792835301375"

[ElpanovEvgeniy]

The problem was born from the need to create a field in AutoCAD 2008 x64 sp1

Code: [Select]

(vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object)))
no method 'GetObjectIDString

Code: [Select]

(vlax-invoke
  (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object)))
  'GetObjectIDString
  (vlax-ename->vla-object (car (entsel)))
)
returns

Code: [Select]

; error: ActiveX Server returned the error: unknown name: "GETOBJECTIDSTRING"
_$

[Lee Mac]

Hi Lee Mac!
In your code has a bug.
See if you have
(hex2dec "1234567890abcdef"); =>> "1311768467294899800"
must
(hex2dec "1234567890abcdef"); =>> "1311768467294899695"

I noticed - I think this is due to the accuracy lost when dividing doubles. I shall have to consider another method, perhaps looking at the patterns of the digits of multiples of 16.

[irneb]

Exactly! I get a similar, yet slightly different error using my general purpose routines:

Code: [Select]

_$ (dec->string (base->dec "7ffffcf5c20" 16))
"879689834528"
_$ (dec->string (base->dec "1311768467294899695" 16))
"5627943617999796174848"
_$ (dec->string (base->dec "1234567890abcdef" 16))
"1311768467294899712"
_$ (dec->string (base->dec "fedcba0987654321" 16))
"18364757930599071744"
_$ (dec->string (base->dec "111111111111" 16))
"18764998447377"
_$ (dec->string (base->dec "ffffffffffff" 16))
"281474976710655"

[ElpanovEvgeniy]

Exactly! I get a similar, yet slightly different error using my general purpose routines:

Code: [Select]

_$ (dec->string (base->dec "7ffffcf5c20" 16))
"879689834528"
_$ (dec->string (base->dec "1311768467294899695" 16))
"5627943617999796174848"
_$ (dec->string (base->dec "1234567890abcdef" 16))
"1311768467294899712"
_$ (dec->string (base->dec "fedcba0987654321" 16))
"18364757930599071744"
_$ (dec->string (base->dec "111111111111" 16))
"18764998447377"
_$ (dec->string (base->dec "ffffffffffff" 16))
"281474976710655"

Great job!
It remains a bit:

Code: [Select]

(dec->string (base->dec  "1234567890abcdef" 16)); =>> "1311768467294899712"must

Code: [Select]

(hex2dec "1234567890abcdef"); =>> "1311768467294899695"

[irneb]

That's what I meant about a "slightly different error". Though I think it's due to the way I change a float into a string. The division by a number other than a factor of 2 would usually cause floating point errors. One of the reasons I have a (> frac 1.e-10) in that routine instead of simply a (> frac 0.).

I wonder if one shouldn't rather implement something like a BCD number system for this case. Though it seems to get to that one might just as well implement a BigNum through a list structure. Yet another point where AutoLisp has fallen behind CL. That 2147483647 is the maximum 32bit signed integer value available, now with 64bit programs it's just not good enough for stuff like ID's.

[ElpanovEvgeniy]

Yet another point where AutoLisp has fallen behind CL. That 2147483647 is the maximum 32bit signed integer value available, now with 64bit programs it's just not good enough for stuff like ID's.

I had the 46 line, to solve the task ...

[VovKa]

translated from the stolen vb code

Code: [Select]

(defun vk_BaseToBase (h ib ob / lst n)
  (repeat (1+ (fix (* (strlen h) (/ (log ib) (log ob))))) (setq lst (cons 0 lst)))
  (foreach c (vl-string->list h)
    (setq n   (- c
(if (< c 58)
   48
   55
)
      )
  lst (mapcar (function (lambda (d)
  (setq d (+ (* d ib) n)
n (/ d ob)
  )
  (rem d ob)
)
      )
      lst
      )
    )
  )
  (apply 'strcat
(reverse (mapcar (function (lambda (c)
      (chr (+ c
      (if (< c 10)
48
55
      )
   )
      )
    )
  )
  lst
  )
)
  )
)
;;;(vk_BaseToBase (vk_BaseToBase "FFFFFFFFFFFFFFFFFFFFFFFFFFFFF" 16 10) 10 16)

[ElpanovEvgeniy]

translated from the stolen vb code

Code: [Select]

(defun vk_BaseToBase (h ib ob / lst n)
  (repeat (1+ (fix (* (strlen h) (/ (log ib) (log ob))))) (setq lst (cons 0 lst)))
  (foreach c (vl-string->list h)
    (setq n   (- c
(if (< c 58)
   48
   55
)
      )
  lst (mapcar (function (lambda (d)
  (setq d (+ (* d ib) n)
n (/ d ob)
  )
  (rem d ob)
)
      )
      lst
      )
    )
  )
  (apply 'strcat
(reverse (mapcar (function (lambda (c)
      (chr (+ c
      (if (< c 10)
48
55
      )
   )
      )
    )
  )
  lst
  )
)
  )
)
;;;(vk_BaseToBase (vk_BaseToBase "FFFFFFFFFFFFFFFFFFFFFFFFFFFFF" 16 10) 10 16)

Code: [Select]

(setq s "FFFFFFFFFFFFFFFFFFFFFFFFFFFFF")
(strlen s) ;== 29
(strlen (vk_BaseToBase (vk_BaseToBase s 16 10) 10 16)) ;== 30

[VovKa]

yep, leading zeros to be removed via vl-string-left-trim

[ElpanovEvgeniy]

yep, leading zeros to be removed via vl-string-left-trim

You did a very concise program!
My version is somewhat more complicated ...

[Lee Mac]

Not as clean as VovKa's:

Code: [Select]

(defun hex2dec ( str / l1 l2 mat pas vec x x1 )
    (setq vec (mapcar '(lambda ( x ) (- x (if (< x 58) 48 55))) (vl-string->list (strcase str)))
          pas (_pascalmatrix (length vec) '((1.0)))
          mat pas
    )
    (repeat 5 (setq mat (mxm mat pas)))
    (setq l1 (reverse (vxm vec mat))
          x1 (car l1)
    )
    (while (< 0 x1)
        (setq l2 (cons (chr (+ (fix (rem x1 10)) 48)) l2)
              l1 (cdr l1)
              x1 (+ (/ (fix x1) 10) (cond ((car l1)) (0)))
        )
    )
    (apply 'strcat l2)
)

(defun _pascalmatrix ( n l )
    (if (< n 2)
        l
        (_pascalmatrix (1- n)
            (cons
                (mapcar '+ (cons 0.0 (car l)) (append (car l) '(0.0)))
                (mapcar (function (lambda ( x ) (cons 0.0 x))) l)
            )
        )
    )
)

;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
    (apply 'mapcar (cons 'list m))
)

;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
    ( (lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun vxm ( v m )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) (trp m))
)
Using the algorithm described here.

[ElpanovEvgeniy]

Hi Lee Mac!
Great job!
Program is working properly.

[ElpanovEvgeniy]

my version:

Code: [Select]

(defun eea-hex2dec (s / L f1 f2 f3 f4 f5)
  (defun f1 (s)
    (mapcar (function (lambda (a)
                        (- a
                           (if (<= a 57)
                             48
                             55
                           )
                        )
                      )
            )
            (vl-string->list (strcase s))
    )
  )
  (defun f3 (i)
    (defun f2 (i)
      (if (> i 9)
        (append (f2 (/ i 10)) (f2 (rem i 10)))
        (list i)
      )
    )
    (reverse (f2 i))
  )
  (defun f4 (l)
    (if l
      (cons (car l) (f4 (mapcar (function (lambda (a) (cons 0 a))) (cdr l))))
    )
  )
  (defun f5 (l / f)
    (if l
      (cons (apply (function +) (mapcar (function car) l)) (f5 (vl-remove nil (mapcar (function cdr) l))))
    )
  )
  (setq s (f1 s)
        l '(0)
  )
  (while s
    (setq l (mapcar (function (lambda (a) (* a 16))) l)
          l (cons (+ (car l) (car s)) (cdr l))
          s (cdr s)
    )
    (setq l (f5 (f4 (mapcar (function f3) l))))
  )
  (while (vl-some (function (lambda (a) (> a 9))) l) (setq l (f5 (f4 (mapcar (function f3) l)))))
  (apply (function strcat) (mapcar (function itoa) (reverse l)))
)

[Lee Mac]

Very nice algorithm VovKa