How do I convert a decimal number to a list of octal digits in Common Lisp?

眉间皱痕 提交于 2020-01-04 08:11:10

问题


I need to have the result in correct order. It works for numbers less than 100 only.

(base8 8) gives (1 0),

(base8 20) gives (2 4),

but (base8 100) gives (414) instead of (144).

I tried for 2 days and can not find the problem. Please help me.

(defun base8(n) 
  (cond
    ((zerop (truncate n 8)) (cons n nil))  
    (t (reverse (cons (mod n 8)
                      (base8 (truncate n 8)))))))

回答1:


The problem is that you are reversing the string a few times. The following will do:

(defun base8 (n)
  (let ((t8 (truncate n 8)) (m8 (mod n 8)))
    (if (= t8 0) 
      (list m8)
      (append (base8 t8) (list m8)))))

EDIT

Here's a solution without append, using a helper function. You'll see clearly that one reverse is enough:

(defun base8-helper (n)
  (let ((t8 (truncate n 8)) (m8 (mod n 8)))
    (cons m8 (if (= t8 0)
               nil
               (base8-helper t8)))))

(defun base8 (n)
  (reverse (base8-helper n)))

or, with an accumulator (tail-recursive)

(defun base8 (n &optional (acc '()))
  (let ((t8 (truncate n 8)) (m8 (mod n 8)))
    (if (= t8 0)
      (cons m8 acc)
      (base8 t8 (cons m8 acc)))))



回答2:


A slightly shorter version:

(defun number->list (number &key (radix 10))
  (loop
     :with result := nil
     :until (zerop number) :do
     (multiple-value-bind (whole remainder)
         (floor number radix)
       (push remainder result)
       (setf number whole))
     :finally (return result)))

And even shorter, using iterate:

(ql:quickload :iterate)
(use-package :iterate)

(defun number->list (number &key (radix 10))
  (iter (until (zerop number))
        (multiple-value-bind (whole remainder)
            (floor number radix)
          (setf number whole)
          (collect remainder at start))))

I knew that optimizing compilers could potentially change the code to replace more costly division with (un-)signed shifts and what not. And indeed SBCL generates the code that does something very similar to what Joshua Tailor posted, however, you get this only if you provide necessary type declaration and compilation declarations:

(declaim (inline number->list)
         (ftype (function (fixnum &key (radix fixnum)) list)))
(defun number->list (number &key (radix 10))
  (iter (until (zerop number))
        (multiple-value-bind (whole reminder)
            (floor number radix)
          (setf number whole)
          (collect reminder at start))))

(defun test-optimize () (number->list 64 :radix 8))

This disassembles into:

; disassembly for TEST-OPTIMIZE
; 05B02F28:       48C745F080000000 MOV QWORD PTR [RBP-16], 128  ; no-arg-parsing entry point
;     2F30:       48C745E817001020 MOV QWORD PTR [RBP-24], 537919511
;     2F38:       E913010000       JMP L6
;     2F3D:       0F1F00           NOP
;     2F40: L0:   488B4DF0         MOV RCX, [RBP-16]
;     2F44:       48894DF8         MOV [RBP-8], RCX
;     2F48:       488B55F0         MOV RDX, [RBP-16]
;     2F4C:       31FF             XOR EDI, EDI
;     2F4E:       488D0C25E5030020 LEA RCX, [#x200003E5]      ; GENERIC-<
;     2F56:       FFD1             CALL RCX
;     2F58:       0F8D2B010000     JNL L8
;     2F5E:       488B55F0         MOV RDX, [RBP-16]
;     2F62:       4C8D1C2581030020 LEA R11, [#x20000381]      ; GENERIC-NEGATE
;     2F6A:       41FFD3           CALL R11
;     2F6D:       480F42E3         CMOVB RSP, RBX
;     2F71:       488D5C24F0       LEA RBX, [RSP-16]
;     2F76:       4883EC18         SUB RSP, 24
;     2F7A:       48C7C7FAFFFFFF   MOV RDI, -6
;     2F81:       488B0548FFFFFF   MOV RAX, [RIP-184]         ; #<FDEFINITION object for ASH>
;     2F88:       B904000000       MOV ECX, 4
;     2F8D:       48892B           MOV [RBX], RBP
;     2F90:       488BEB           MOV RBP, RBX
;     2F93:       FF5009           CALL QWORD PTR [RAX+9]
;     2F96:       4C8D1C2581030020 LEA R11, [#x20000381]      ; GENERIC-NEGATE
;     2F9E:       41FFD3           CALL R11
;     2FA1:       480F42E3         CMOVB RSP, RBX
;     2FA5:       488955F8         MOV [RBP-8], RDX
;     2FA9:       488B55F0         MOV RDX, [RBP-16]
;     2FAD:       4C8D1C2581030020 LEA R11, [#x20000381]      ; GENERIC-NEGATE
;     2FB5:       41FFD3           CALL R11
;     2FB8:       480F42E3         CMOVB RSP, RBX
;     2FBC:       BF0E000000       MOV EDI, 14
;     2FC1:       4883EC18         SUB RSP, 24
;     2FC5:       48896C2408       MOV [RSP+8], RBP
;     2FCA:       488D6C2408       LEA RBP, [RSP+8]
;     2FCF:       B904000000       MOV ECX, 4
;     2FD4:       488B0425580F1020 MOV RAX, [#x20100F58]
;     2FDC:       FFD0             CALL RAX
;     2FDE:       48F7DA           NEG RDX
;     2FE1:       488B5DF8         MOV RBX, [RBP-8]
;     2FE5:       488955F8         MOV [RBP-8], RDX
;     2FE9: L1:   48837DF800       CMP QWORD PTR [RBP-8], 0
;     2FEE:       741A             JEQ L2
;     2FF0:       48895DE0         MOV [RBP-32], RBX
;     2FF4:       488B55F0         MOV RDX, [RBP-16]
;     2FF8:       31FF             XOR EDI, EDI
;     2FFA:       488D0C25E5030020 LEA RCX, [#x200003E5]      ; GENERIC-<
;     3002:       FFD1             CALL RCX
;     3004:       488B5DE0         MOV RBX, [RBP-32]
;     3008:       7C5B             JL L7
;     300A: L2:   488BCB           MOV RCX, RBX
;     300D:       488B55F8         MOV RDX, [RBP-8]
;     3011: L3:   48894DF0         MOV [RBP-16], RCX
;     3015:       49896C2440       MOV [R12+64], RBP
;     301A:       4D8B5C2418       MOV R11, [R12+24]
;     301F:       498D4B10         LEA RCX, [R11+16]
;     3023:       49394C2420       CMP [R12+32], RCX
;     3028:       0F86C0000000     JBE L9
;     302E:       49894C2418       MOV [R12+24], RCX
;     3033:       498D4B07         LEA RCX, [R11+7]
;     3037: L4:   49316C2440       XOR [R12+64], RBP
;     303C:       7402             JEQ L5
;     303E:       CC09             BREAK 9                    ; pending interrupt trap
;     3040: L5:   488951F9         MOV [RCX-7], RDX
;     3044:       488B55E8         MOV RDX, [RBP-24]
;     3048:       48895101         MOV [RCX+1], RDX
;     304C:       48894DE8         MOV [RBP-24], RCX
;     3050: L6:   48837DF000       CMP QWORD PTR [RBP-16], 0
;     3055:       0F85E5FEFFFF     JNE L0
;     305B:       488B55E8         MOV RDX, [RBP-24]
;     305F:       488BE5           MOV RSP, RBP
;     3062:       F8               CLC
;     3063:       5D               POP RBP
;     3064:       C3               RET
;     3065: L7:   BF02000000       MOV EDI, 2
;     306A:       488BD3           MOV RDX, RBX
;     306D:       4C8D1C254C020020 LEA R11, [#x2000024C]      ; GENERIC--
;     3075:       41FFD3           CALL R11
;     3078:       480F42E3         CMOVB RSP, RBX
;     307C:       488BCA           MOV RCX, RDX
;     307F:       488B55F8         MOV RDX, [RBP-8]
;     3083:       4883C210         ADD RDX, 16
;     3087:       EB88             JMP L3
;     3089: L8:   488D5C24F0       LEA RBX, [RSP-16]
;     308E:       4883EC18         SUB RSP, 24
;     3092:       488B55F8         MOV RDX, [RBP-8]
;     3096:       48C7C7FAFFFFFF   MOV RDI, -6
;     309D:       488B052CFEFFFF   MOV RAX, [RIP-468]         ; #<FDEFINITION object for ASH>
;     30A4:       B904000000       MOV ECX, 4
;     30A9:       48892B           MOV [RBX], RBP
;     30AC:       488BEB           MOV RBP, RBX
;     30AF:       FF5009           CALL QWORD PTR [RAX+9]
;     30B2:       488955F8         MOV [RBP-8], RDX
;     30B6:       488B55F0         MOV RDX, [RBP-16]
;     30BA:       BF0E000000       MOV EDI, 14
;     30BF:       4883EC18         SUB RSP, 24
;     30C3:       48896C2408       MOV [RSP+8], RBP
;     30C8:       488D6C2408       LEA RBP, [RSP+8]
;     30CD:       B904000000       MOV ECX, 4
;     30D2:       488B0425580F1020 MOV RAX, [#x20100F58]
;     30DA:       FFD0             CALL RAX
;     30DC:       488B5DF8         MOV RBX, [RBP-8]
;     30E0:       488955F8         MOV [RBP-8], RDX
;     30E4:       E900FFFFFF       JMP L1
;     30E9:       CC0A             BREAK 10                   ; error trap
;     30EB:       02               BYTE #X02
;     30EC:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;     30ED:       54               BYTE #X54                  ; RCX
;     30EE: L9:   6A10             PUSH 16
;     30F0:       4C8D1C2590FF4100 LEA R11, [#x41FF90]        ; alloc_tramp
;     30F8:       41FFD3           CALL R11
;     30FB:       59               POP RCX
;     30FC:       488D4907         LEA RCX, [RCX+7]
;     3100:       E932FFFFFF       JMP L4

Note the line: 2F81, it is where the function ash is called (which was substituted for division).




回答3:


The problem with your current code

Uselpa correctly pointed out that the problem in the code you've given is that reverse is called too many times. It may be useful to take a step back and think of the definition here without thinking about Lisp code. First, the code was:

(defun base8 (n) 
  (cond
    ((zerop (truncate n 8)) (cons n nil))  
    (t (reverse (cons (mod n 8)
                      (base8 (truncate n 8)))))))

The idea is that (base8 n) returns the list of octits of n.

The first case, where n < 8 (which you're checking with (zerop (truncate n 8))) is right. If n < 8 then the result should simply be a list containing n. You can do that (as you did) with (cons n nil), though (list n) would probably be more idiomatic. In either case, it's right.

The recursive case is a bit trickier though. Let's consider a number n which, written in octal has five octits: abcde. There's a recursive call, (base8 (truncate n 8)). If we assume that base8 works correctly for the subcase, then this means that

(base8 (truncate abcde 8)) ===
(base8 abcd)               ===
'(a b c d)

Now, (mod n 8) returns e. When you cons e and (a b c d) together, you get (e a b c d), and when you reverse that, you get (d c b a e), and that's what you're returning from base8 for abcde, and this isn't right. If base8 returns returns the octits in a list with the most significant octit first, you'd need to join e and (a b c d) with something like (append '(a b c d) (list 'e)), which is to say

(append (base8 (truncate n 8))
        (list (mod n 8)))

That's not particularly efficient, and it does a lot of list copying. It's probably easier to generate the list of octits in reverse order with a helper function, and then have base8 call that helper function, get the list of octits in reverse order, and reverse and return it. That's what the next solutions I'll show do, although I'll be using some bit-operations to handle the division by eight rather than truncate and mod.

Efficient solutions with binary operations

Since the title of the question is How do I convert a decimal number to a list of octal digits in Common Lisp?, I think it's worth considering some options that don't use truncate, since that might be sort of expensive (e.g., see Improving performance for converting numbers to lists, and base10 to base2, and the observation that using binary arithmetic instead of quotient and remainder is faster).

The the first three bits of number correspond to its first numeral in base 8. This means that (ldb (byte 3 0) number) gives the remainder of number divided by 8, and (ash number -3)gives the quotient of number divided by 8. You can collect the octits in order from least to most significant significant octit by collecting (ldb (byte 3 0) number) and updating number to (ash number -3). If you want the least significant octit of the number to be first in the list, you could return (nreverse octits) instead of octits.

(defun base8 (number)
  (do ((octits '() (cons (ldb (byte 3 0) number) octits))
       (number number (ash number -3)))
      ((zerop number) octits)))
CL-USER> (base8 123)
(1 7 3)
CL-USER> (base8 11)
(1 3)
CL-USER> (base8 83)
(1 2 3)

The structure of the previous code is iterative, but corresponds directly to a recursive version. If you prefer the recursive version, it's this:

(defun base8 (number)
  (labels ((b8 (number octits)
             (if (zerop number)
                 octits
                 (b8 (ash number -3)
                     (cons (ldb (byte 3 0) number)
                           octits)))))
    (b8 number '())))

The labels in that code simply establishes a local function called b8. You could define it with a separate defun if you wanted to and call it from base8:

(defun base8 (number)
  (b8 number '()))

(defun b8 (number octits)
  (if (zerop number)
      octits
      (b8 (ash number -3)
          (cons (ldb (byte 3 0) number)
                octits))))

An unorthodox (and probably inefficient) solution

Here's a silly solution that writes the number in octal, and then converts each digit character to the corresponding number:

(defun base8 (number)
  (map 'list #'(lambda (x)
                 (position x "01234567" :test 'char=))
       (write-to-string number :base 8)))



回答4:


I'd use loop for this one:

(defun as-base-n-list (n base)
  (check-type n (integer 0) "a nonnegative integer")
  (check-type base (integer 1) "a positive integer")
  (loop for x = n then (floor x base)
     nconcing (list (mod x base))
     while (>= x base)))

(defun base8 (n)
  (as-base-n-list n 8))

Needing to use list to feed the nconcing accumulation clause is ugly. Alternately, you could use collect into and reverse the accumulated list with nreverse before returning from the loop form.


While the version above is clear enough, I like this version of as-base-n-list better, which eliminates the redundant call to mod above:

(defun as-base-n-list (n base)
  (check-type n (integer 0) "a nonnegative integer")
  (check-type base (integer 1) "a positive integer")
  (loop with remainder
     do (multiple-value-setq (n remainder) (floor n base))
     nconcing (list remainder)
     until (zerop n)))

This one takes advantage of floor returning multiple values.



来源:https://stackoverflow.com/questions/19892507/how-do-i-convert-a-decimal-number-to-a-list-of-octal-digits-in-common-lisp

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!